Analysis of DIH Prosecutions: 2000 to 2019, OLS
Kelly Kung
4/18/2022
1 Set Up
1.1 R Code
#packages we need for this code file
library(ggplot2)
library(mgcv)
library(lubridate)
library(zoo)
library(tidyverse)
library(dplyr)
library(DHARMa)
library(mgcViz)
library(extrafont)
library(arm)
loadfonts()
library(stargazer)
library(ellipse)
library(dotwhisker)
library(countreg)#define functions we will need for analysis
#expit function
expit<-function(x){
return(exp(x)/(1 + exp(x)))
}
#logit function
logit<-function(x){
return(log(x/(1 - x)))
}1.2 Data
#read in data
main_analysis_data<-read.csv("./Data/full_data_set_11_29_21_unintentional.csv")
################################## set up data set ################################
#add the intervention dates and time period data
main_analysis_data$Intervention_First_Date<-as.Date(main_analysis_data$Intervention_First_Date)
main_analysis_data$Time_Period_Start<-as.Date(main_analysis_data$Time_Period_Start)
names(main_analysis_data)[which(colnames(main_analysis_data) == "sum_deaths")] <- "imputed_deaths"
################################## set up the Regions ##############################
#set up the regions according to Census: https://www.census.gov/geographies/reference-maps/2010/geo/2010-census-regions-and-divisions-of-the-united-states.html
NE.name <- c("Connecticut","Maine","Massachusetts","New Hampshire",
"Rhode Island","Vermont","New Jersey","New York",
"Pennsylvania")
MW.name <- c("Indiana","Illinois","Michigan","Ohio","Wisconsin",
"Iowa","Kansas","Minnesota","Missouri","Nebraska",
"North Dakota","South Dakota")
S.name <- c("Delaware","District of Columbia","Florida","Georgia",
"Maryland","North Carolina","South Carolina","Virginia",
"West Virginia","Alabama","Kentucky","Mississippi",
"Tennessee","Arkansas","Louisiana","Oklahoma","Texas")
W.name <- c("Arizona","Colorado","Idaho","New Mexico","Montana",
"Utah","Nevada","Wyoming","Alaska","California",
"Hawaii","Oregon","Washington")
region.list <- list(
Northeast=NE.name,
Midwest=MW.name,
South=S.name,
West=W.name)
#initialize vector with "West" and then impute the other regions for the states
main_analysis_data$Region<-rep("West", nrow(main_analysis_data))
for(state in unique(main_analysis_data$State)){
if(state %in% region.list$Northeast){
main_analysis_data$Region[main_analysis_data$State == state]<-"Northeast"
}else if(state %in% region.list$Midwest){
main_analysis_data$Region[main_analysis_data$State == state]<-"Midwest"
}else if(state %in% region.list$South){
main_analysis_data$Region[main_analysis_data$State == state]<-"South"
}
}2 Sandwich Estimator Code
#here, we estimate the variance-covariance matrix through the sandwich estimator
#we create a function so that we don't have to keep writing the code:
#cov_data is such that rows are state-time combinations and columns are the different policy measures
#coef_values need to be in order of the columns of cov_data
#z_value is the z-value that corresponds to the CI. We default to 95% CI so we default to 1.96
#we take k as the number of parametesr for a bias correction
compute_sd_and_CI <- function(cov_data, observed_y, coef_values, z_value = 1.96, k,
print_full_cov = FALSE){
middle_term <- matrix(0, nrow = ncol(cov_data), ncol = ncol(cov_data))
for(i in 1:nrow(cov_data)){
#sum_{s,t} (z_{s,t}z_{s,t}^T)*(y_{s,t}-z_{s,t}^T theta)^2
middle_term <- middle_term + tcrossprod(as.matrix(cov_data[i,]))*
as.numeric((observed_y[i] - t(as.matrix(cov_data[i,]))%*%coef_values)^2)
}
#(Z^T Z)^{-1}*middle_term*(Z^T Z)^{-1}
var_cov <- solve(crossprod(cov_data))%*%(middle_term)%*%solve(crossprod(cov_data))*(nrow(cov_data)/(nrow(cov_data) - k))
#we obtain the standard deviations by taking the square root of the diagonal of the variance-covariance matrix.
sd_of_coefficients <- sqrt(diag(var_cov))
#find the CI for the coefficients
lb_coef <- coef_values - z_value*(sd_of_coefficients)
ub_coef <- coef_values + z_value*(sd_of_coefficients)
return_data_set <- data.frame(lb_coef, coef_values, ub_coef, sd_coef = sd_of_coefficients)
if(print_full_cov){
return(list(return_data_set = return_data_set, var_cov = var_cov))
}else{
return(return_data_set)
}
}3 Attributable Deaths Computation
3.1 Not Bootstrap
attr_death_compute <- function(data, coef_data, lin_model = FALSE, tx_name = NULL,
var_cov_mat_beta = NULL){
attr_table <- data.frame(matrix(NA, nrow = unique(data$Time_Period_ID), ncol = 4))
#filter data so that it's only states where there was treatment
data <- data %>%
filter(Intervention_Redefined > 0)
for(time in unique(data$Time_Period_ID)){
#filter data to time period t
time_data <- data %>%
filter(Time_Period_ID == time)
#obtain the population
pop <- time_data$population
#obtain the estimated probability had intervention not occurred
#here, we compute x^T*beta where x is a vector of the covariates and beta is the corresponding coefficients
if(lin_model == FALSE){
pd_coef_names <- sapply(0:39, function(k){paste("pos_", k, "_pd", sep = "")})
est_prob_no_int <- time_data[,"prop_dead"]*exp(- as.matrix(time_data[,pd_coef_names])%*%
as.matrix(coef_data[pd_coef_names, "estimate"]))
}else{
est_prob_no_int <- time_data[,"prop_dead"]*exp(- as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name, "estimate"]))
}
#estimated number of OD had intervention not occurred
n_od_no_int <- pop*est_prob_no_int
#obtain LB
if(lin_model == FALSE){
pd_coef_names <- sapply(0:39, function(k){paste("pos_", k, "_pd", sep = "")})
est_prob_no_int_lb <- time_data[,"prop_dead"]*exp(- as.matrix(time_data[,pd_coef_names])%*%
as.matrix(coef_data[pd_coef_names, "conf.low"]))
n_attr_od_lb <- sum(pop*est_prob_no_int_lb) - sum(time_data$imputed_deaths)
}else{
if(length(tx_name) == 1){
est_prob_no_int_lb <- time_data[,"prop_dead"]*exp(- as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name, "conf.low"]))
n_attr_od_lb <- sum(pop*est_prob_no_int_lb) - sum(time_data$imputed_deaths)
}else{
jacobian_first_entry <- sum(time_data$population*time_data$prop_dead*
exp(-as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name,"estimate"]))*
time_data[,tx_name[1]])
jacobian_second_entry <- sum(time_data$population*time_data$prop_dead*
exp(-as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name,"estimate"]))*
time_data[,tx_name[2]])
jacobian_mat <- matrix(c(jacobian_first_entry, jacobian_second_entry), nrow = 1)
computed_sd <- sqrt(tcrossprod(jacobian_mat%*%var_cov_mat_beta, jacobian_mat))
n_attr_od_lb <- sum(n_od_no_int) - sum(time_data$imputed_deaths) - 1.96*computed_sd
}
}
#obtain UB
if(lin_model == FALSE){
pd_coef_names <- sapply(0:39, function(k){paste("pos_", k, "_pd", sep = "")})
est_prob_no_int_ub <- time_data[,"prop_dead"]*exp(- as.matrix(time_data[,pd_coef_names])%*%
as.matrix(coef_data[pd_coef_names, "conf.high"]))
n_attr_od_ub <- sum(pop*est_prob_no_int_ub) - sum(time_data$imputed_deaths)
}else{
if(length(tx_name) == 1){
est_prob_no_int_ub <- time_data[,"prop_dead"]*exp(-as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name, "conf.high"]))
n_attr_od_ub <- sum(pop*est_prob_no_int_ub) - sum(time_data$imputed_deaths)
}else{
jacobian_first_entry <- sum(time_data$population*time_data$prop_dead*
exp(-as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name,"estimate"]))*
time_data[,tx_name[1]])
jacobian_second_entry <- sum(time_data$population*time_data$prop_dead*
exp(-as.matrix(time_data[,tx_name])%*%as.matrix(coef_data[tx_name,"estimate"]))*
time_data[,tx_name[2]])
jacobian_mat <- matrix(c(jacobian_first_entry, jacobian_second_entry), nrow = 1)
computed_sd <- sqrt(tcrossprod(jacobian_mat%*%var_cov_mat_beta, jacobian_mat))
n_attr_od_ub <- (sum(n_od_no_int) - sum(time_data$imputed_deaths)) + 1.96*computed_sd
}
}
attr_table[time,] <- c(time, sum(n_od_no_int) - sum(time_data$imputed_deaths),
(n_attr_od_lb) ,
(n_attr_od_ub) )
}
colnames(attr_table) <- c("Time_Period", "attr_deaths", "attr_deaths_lb", "attr_deaths_ub")
attr_table
}4 Bootstrap Data Code
#bootstrap code to estimate coefficients and attributable deaths
boostrap_state_time_group <- function(data, model, coef_of_interest, nSim = 1000, seed = 1234){
coef_store_data <- data.frame(matrix(NA, nrow = nSim, ncol = length(coef_of_interest)))
set.seed(seed)
for(sim in 1:nSim){
#sample the data so that it's the same size
# sample_data <- sample(1:nrow(data), nrow(data), replace = TRUE)
sample_data <- sample(unique(data$State), length(unique(data$State)), replace = TRUE)
# boot_data <- data[sample_data,]
boot_data <- data.frame()
for(state in sample_data){
boot_data <- rbind(boot_data, data[data$State == state,])
}
#fit model with bootstrao data
boot_model <- update(model, data = boot_data)
#store coefficient results
coef_store_data[sim,] <- coef(boot_model)[coef_of_interest]
}
return(coef_store_data)
}
boostrap_state_time_unit <- function(data, model, coef_of_interest, nSim = 1000, seed = 1234){
coef_store_data <- data.frame(matrix(NA, nrow = nSim, ncol = length(coef_of_interest)))
set.seed(seed)
for(sim in 1:nSim){
#sample the data so that it's the same size
sample_data <- sample(1:nrow(data), nrow(data), replace = TRUE)
# sample_data <- sample(unique(data$State), length(unique(data$State)), replace = TRUE)
boot_data <- data[sample_data,]
# boot_data <- data.frame()
# for(state in sample_data){
# boot_data <- rbind(boot_data, data[data$State == state,])
#
# }
#fit model with bootstrao data
boot_model <- update(model, data = boot_data)
#store coefficient results
coef_store_data[sim,] <- coef(boot_model)[coef_of_interest]
}
return(coef_store_data)
}5 Event Study Data Creation
main_analysis_data$prop_dead <- main_analysis_data$imputed_deaths/main_analysis_data$population
#create the dataset for the event study to check for pre-trend analysis
time_data_int <- main_analysis_data %>%
#group by the state
group_by(State) %>%
#find the time interval ID for the intervention time
summarise(intervention_time_id = ifelse(floor_date(Intervention_First_Date, "6 months") == Time_Period_Start, Time_Period_ID, NA)) %>%
#filter out the other time periods that aren't the intervention date
filter(!is.na(intervention_time_id))
#merge the time_data_int with the main dataset
merged_main_time_data_int <- merge(main_analysis_data, time_data_int, by = "State", all.x = TRUE)
#create the columns that associate with the periods before the intervention
#the max number of periods before the intervention is determined by the maximum time period of the intervention
neg_periods_df <- sapply(1:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 1),
#the indicator for x periods before intervention is equal to 1 if the time ID of intervention minus time ID is equal to x
function(x){ifelse(merged_main_time_data_int$intervention_time_id -
merged_main_time_data_int$Time_Period_ID == x, 1, 0)})
#create the column names
colnames(neg_periods_df) <- sapply(1:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 1),
function(x){paste("neg_", x, "_pd", sep = "")})
#add in the state and time ID columns
neg_periods_df <- cbind(neg_periods_df, "State" = merged_main_time_data_int$State,
"Time_Period_ID" = merged_main_time_data_int$Time_Period_ID)
#for Hawaii, impute a 0 because it is NA right now
neg_periods_df[neg_periods_df[,"State"] == "Hawaii", 1:34] <- 0
#create the columns that associate with the periods after the intervention
#the max number of periods after the intervention is determined by the maximum Time ID minus the minus time period of the intervention
#the period 0 is associated with intervention time
pos_periods_df <- sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x){ifelse(merged_main_time_data_int$Time_Period_ID -
merged_main_time_data_int$intervention_time_id == x, 1, 0)})
#create the column names
colnames(pos_periods_df) <- sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x){paste("pos_", x, "_pd", sep = "")})
#add in the state and time ID columns
pos_periods_df <- cbind(pos_periods_df, "State" = merged_main_time_data_int$State,
"Time_Period_ID" = merged_main_time_data_int$Time_Period_ID)
#for Hawaii, impute a 0 because it is NA right now
pos_periods_df[pos_periods_df[,"State"] == "Hawaii", 1:40] <- 0
#merge the columns of indicators for before and after the intervention with the main analysis data to create the dataset for event study
sensitivity_anlys_event_study_data <- merge(main_analysis_data,
neg_periods_df, by = c("State", "Time_Period_ID"))
sensitivity_anlys_event_study_data <- merge(sensitivity_anlys_event_study_data,
pos_periods_df, by = c("State", "Time_Period_ID"))
#change the indicator values to numeric type
neg_1_index <- which(colnames(sensitivity_anlys_event_study_data) == "neg_1_pd")
pos_39_index <- which(colnames(sensitivity_anlys_event_study_data) == "pos_39_pd")
sensitivity_anlys_event_study_data[, neg_1_index:pos_39_index] <- apply(sensitivity_anlys_event_study_data[, neg_1_index:pos_39_index],
2, as.numeric)6 OLS Model Main Analysis With Smoothed Time Effects With Log Proportion
#compute the proportion of people who died from drug overdose
main_analysis_data$prop_dead <- main_analysis_data$imputed_deaths/main_analysis_data$population
#fit an OLS with smoothed time effects
main_analysis_model_log_smoothed_time<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
Naloxone_Pharmacy_No_Redefined +
Medical_Marijuana_Redefined +
Recreational_Marijuana_Redefined +
GSL_Redefined +
PDMP_Redefined +
Medicaid_Expansion_Redefined +
Intervention_Redefined ,
data = main_analysis_data)
summary(main_analysis_model_log_smoothed_time)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + Naloxone_Pharmacy_No_Redefined +
## Medical_Marijuana_Redefined + Recreational_Marijuana_Redefined +
## GSL_Redefined + PDMP_Redefined + Medicaid_Expansion_Redefined +
## Intervention_Redefined
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.711293 0.052777 -184.006 < 2e-16 ***
## StateAlaska 0.164106 0.074380 2.206 0.027480 *
## StateArizona 0.288302 0.067744 4.256 2.18e-05 ***
## StateArkansas -0.487283 0.066740 -7.301 4.16e-13 ***
## StateCalifornia -0.155692 0.074371 -2.093 0.036440 *
## StateColorado 0.035981 0.074125 0.485 0.627444
## StateConnecticut 0.230076 0.070893 3.245 0.001193 **
## StateDelaware 0.216431 0.067992 3.183 0.001480 **
## StateFlorida 0.309018 0.066797 4.626 3.97e-06 ***
## StateGeorgia 0.000433 0.066781 0.006 0.994827
## StateHawaii -0.378239 0.072961 -5.184 2.40e-07 ***
## StateIdaho -0.124420 0.066788 -1.863 0.062628 .
## StateIllinois 0.161001 0.067802 2.375 0.017667 *
## StateIndiana 0.081619 0.066357 1.230 0.218845
## StateIowa -0.676997 0.066568 -10.170 < 2e-16 ***
## StateKansas -0.230527 0.066060 -3.490 0.000495 ***
## StateKentucky 0.702316 0.066783 10.516 < 2e-16 ***
## StateLouisiana 0.340740 0.065973 5.165 2.66e-07 ***
## StateMaine 0.088824 0.073874 1.202 0.229369
## StateMaryland -1.513084 0.067786 -22.321 < 2e-16 ***
## StateMassachusetts -0.083599 0.067340 -1.241 0.214593
## StateMichigan 0.010429 0.068383 0.153 0.878801
## StateMinnesota -0.643068 0.069892 -9.201 < 2e-16 ***
## StateMississippi -0.049288 0.066014 -0.747 0.455380
## StateMissouri 0.167659 0.068266 2.456 0.014138 *
## StateMontana -0.439514 0.070271 -6.255 4.90e-10 ***
## StateNebraska -0.874032 0.067084 -13.029 < 2e-16 ***
## StateNevada 0.460178 0.071746 6.414 1.78e-10 ***
## StateNew Hampshire 0.147406 0.067147 2.195 0.028264 *
## StateNew Jersey 0.080613 0.067947 1.186 0.235611
## StateNew Mexico 0.645396 0.072906 8.852 < 2e-16 ***
## StateNew York -0.139492 0.068359 -2.041 0.041429 *
## StateNorth Carolina 0.233840 0.065853 3.551 0.000393 ***
## StateNorth Dakota -1.137555 0.066451 -17.119 < 2e-16 ***
## StateOhio 0.452817 0.066969 6.762 1.80e-11 ***
## StateOklahoma 0.464010 0.066457 6.982 3.99e-12 ***
## StateOregon -0.271552 0.073846 -3.677 0.000242 ***
## StatePennsylvania 0.561023 0.066850 8.392 < 2e-16 ***
## StateRhode Island -0.278774 0.069373 -4.018 6.08e-05 ***
## StateSouth Carolina 0.207544 0.066391 3.126 0.001798 **
## StateSouth Dakota -1.027424 0.066779 -15.386 < 2e-16 ***
## StateTennessee 0.468655 0.065670 7.136 1.35e-12 ***
## StateTexas -0.019383 0.066729 -0.290 0.771481
## StateUtah -0.095477 0.066061 -1.445 0.148542
## StateVermont -0.169566 0.069677 -2.434 0.015041 *
## StateVirginia -0.032103 0.065975 -0.487 0.626602
## StateWashington 0.045026 0.075228 0.599 0.549557
## StateWest Virginia 0.790500 0.066804 11.833 < 2e-16 ***
## StateWisconsin 0.006409 0.066116 0.097 0.922789
## StateWyoming -0.021573 0.066041 -0.327 0.743956
## Naloxone_Pharmacy_Yes_Redefined -0.078516 0.042517 -1.847 0.064946 .
## Naloxone_Pharmacy_No_Redefined -0.001783 0.038500 -0.046 0.963069
## Medical_Marijuana_Redefined 0.192033 0.030656 6.264 4.62e-10 ***
## Recreational_Marijuana_Redefined -0.110335 0.048796 -2.261 0.023863 *
## GSL_Redefined 0.054084 0.031598 1.712 0.087127 .
## PDMP_Redefined -0.152943 0.024680 -6.197 7.02e-10 ***
## Medicaid_Expansion_Redefined 0.091989 0.030149 3.051 0.002311 **
## Intervention_Redefined -0.026254 0.024341 -1.079 0.280903
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 4.779 5.836 140.15 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.464 8.917 82.99 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 6.300 7.442 105.57 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 3.355 4.185 86.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.84 Deviance explained = 84.6%
## GCV = 0.089598 Scale est. = 0.085974 n = 2000gam.check(main_analysis_model_log_smoothed_time, page = 1)
##
## Method: GCV Optimizer: magic
## Smoothing parameter selection converged after 5 iterations.
## The RMS GCV score gradient at convergence was 1.134567e-06 .
## The Hessian was positive definite.
## Model rank = 94 / 94
##
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
##
## k' edf k-index p-value
## s(Time_Period_ID):as.factor(Region)Midwest 9.00 4.78 1.05 0.98
## s(Time_Period_ID):as.factor(Region)Northeast 9.00 8.46 1.05 0.99
## s(Time_Period_ID):as.factor(Region)South 9.00 6.30 1.05 0.99
## s(Time_Period_ID):as.factor(Region)West 9.00 3.36 1.05 0.98#examine fitted values
summary(fitted(main_analysis_model_log_smoothed_time))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -12.314 -10.207 -9.739 -9.796 -9.341 -8.122hist(fitted(main_analysis_model_log_smoothed_time))
#smoothed effects
plot(main_analysis_model_log_smoothed_time, pages = 1)
6.1 Sandwich Estimator: Coefficients and 95% CI
#compute the full dataset including basis functions
full_df_w_basis_functions_log_smoothed_time <- as.matrix(data.frame(predict(main_analysis_model_log_smoothed_time, type = "lpmatrix")))
#estimate the 95% CI and SD
coefficient_values_log_smoothed_time <- coef(main_analysis_model_log_smoothed_time)
#type = "response" to get the estimated probabilities
main_analysis_sd_and_ci_log_smoothed_time <- compute_sd_and_CI(full_df_w_basis_functions_log_smoothed_time,
log(main_analysis_data$prop_dead),
coefficient_values_log_smoothed_time,
k = ncol(full_df_w_basis_functions_log_smoothed_time))
# format(round(main_analysis_sd_and_ci_log_smoothed_time, 3), nsmall = 3)
colnames(main_analysis_sd_and_ci_log_smoothed_time) <- c("conf.low", "estimate", "conf.high", "sd")
main_analysis_sd_and_ci_log_smoothed_time$term <- rownames(main_analysis_sd_and_ci_log_smoothed_time)
main_analysis_sd_and_ci_log_smoothed_time$ci_95 <-
paste("95% CI = (", format(round(main_analysis_sd_and_ci_log_smoothed_time$conf.low, 3), nsmall = 3), ", ",
format(round(main_analysis_sd_and_ci_log_smoothed_time$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(main_analysis_sd_and_ci_log_smoothed_time[51:58,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Exposure Intervention") +
scale_color_grey() +
geom_text(main_analysis_sd_and_ci_log_smoothed_time[51:58,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 8:1), size = 3) +
geom_text(main_analysis_sd_and_ci_log_smoothed_time[51:58,],
mapping = aes(label = ci_95, x = 0.9, y = 8:1), size = 3) +
xlim(-.3, 1.1)
6.2 Attributable Deaths
date_data <- main_analysis_data[, c("Time_Period_ID", "Time_Period_Start")]
date_data <- date_data[!duplicated(date_data),]
attr_deaths_est_log_smoothed_time <- attr_death_compute(main_analysis_data, main_analysis_sd_and_ci_log_smoothed_time,
lin_model = TRUE,
tx_name = "Intervention_Redefined")
attr_deaths_est_log_smoothed_time <- merge(attr_deaths_est_log_smoothed_time, date_data, by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_log_smoothed_time, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
6.3 Bootstrapping: Coefficient and Attributable Death Estimate
bootstrap_smoothed_eff_log_outcome <- boostrap_state_time(main_analysis_data, main_analysis_model_log_smoothed_time,
lin_model = TRUE, tx_name = "Intervention_Redefined")
reduced_coef <- Reduce("cbind", bootstrap_smoothed_eff_log_outcome[[1]])
apply(reduced_coef, 1, quantile, probs = c(.025, .975))
apply(reduced_coef, 1, mean)
coef_w_ci_smoothed_time_log_outcome <- cbind(t(apply(reduced_coef, 1, quantile, probs = c(.025, .975))), apply(reduced_coef, 1, mean))
colnames(coef_w_ci_smoothed_time_log_outcome) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_log_outcome <- data.frame(coef_w_ci_smoothed_time_log_outcome)
coef_w_ci_smoothed_time_log_outcome$term <- rownames(coef_w_ci_smoothed_time_log_outcome)
dwplot(coef_w_ci_smoothed_time_log_outcome[51:58,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Single Intervention, Using Bootstrap") +
scale_color_grey()
# coord_flip() +
# geom_hline(yintercept = 33, col = "red", linetype = "dashed")
list_attr_deaths <- lapply(bootstrap_smoothed_eff_log_outcome[[2]], function(x){x$attr_deaths})
reduced_attr_deaths <- Reduce("cbind", list_attr_deaths)
attr_deaths_smoothed_time_log_outcome <- cbind(t(apply(reduced_attr_deaths, 1, quantile, probs = c(.025, .975), na.rm = TRUE)),
apply(reduced_attr_deaths, 1, mean, na.rm = TRUE))
colnames(attr_deaths_smoothed_time_log_outcome) <- c("conf.low", "conf.high", "estimate")
attr_deaths_smoothed_time_log_outcome <- data.frame(attr_deaths_smoothed_time_log_outcome)
attr_deaths_smoothed_time_log_outcome$Time_Period_Start <- unique(main_analysis_data$Time_Period_Start)
ggplot(attr_deaths_smoothed_time_log_outcome, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = estimate, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Estimated Using Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))6.4 Event Study: All Periods
6.4.1 Model Fitting
#create a formula for the gam model which includes the state effects, smoothed time effects, policy measures,
#the periods before the intervention (excluding 1 period and 34 periods before intervention)
#the intervention period, and the periods after the intervention
formula_event_study_log_smoothed_time <- formula(paste("log(prop_dead) ~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
Naloxone_Pharmacy_No_Redefined +
Medical_Marijuana_Redefined +
Recreational_Marijuana_Redefined +
GSL_Redefined +
PDMP_Redefined +
Medicaid_Expansion_Redefined +",
paste(sapply(2:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)-2),
function(x)paste("neg_", x, "_pd", sep = "")), collapse = "+"),
"+",
paste(sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x)paste("pos_", x, "_pd", sep = "")), collapse = "+")))
#run the gam model
sensitivity_anlys_event_study_model_log_smoothed_time<-gam(formula_event_study_log_smoothed_time,
data = sensitivity_anlys_event_study_data)
# summary(sensitivity_anlys_event_study_model_log_smoothed_time)6.4.2 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_event_study_log_smoothed_time <-
data.frame(predict(sensitivity_anlys_event_study_model_log_smoothed_time, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_event_study_log_smoothed_time <- coef(sensitivity_anlys_event_study_model_log_smoothed_time)
#type = "response" to get the estimated probabilities
sensitivity_anlys_event_study_sd_and_ci_log_smoothed_time <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_event_study_log_smoothed_time),
log(sensitivity_anlys_event_study_data$prop_dead),
coefficient_values_sensitivity_anlys_event_study_log_smoothed_time,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_event_study_log_smoothed_time))
(sensitivity_anlys_event_study_sd_and_ci_log_smoothed_time)## lb_coef coef_values
## (Intercept) -9.730462237 -9.607755377
## StateAlaska -0.049423874 0.101715259
## StateArizona 0.144496017 0.257887425
## StateArkansas -0.626540747 -0.516038962
## StateCalifornia -0.197605999 -0.062450464
## StateColorado -0.121794519 0.002447472
## StateConnecticut 0.087500824 0.222377470
## StateDelaware 0.018646885 0.155066167
## StateFlorida 0.292773480 0.412924559
## StateGeorgia 0.012368305 0.127609736
## StateHawaii -0.610276068 -0.467150486
## StateIdaho -0.276925613 -0.159066931
## StateIllinois 0.103069959 0.233581709
## StateIndiana -0.024961041 0.076071921
## StateIowa -0.734431274 -0.624312899
## StateKansas -0.322260429 -0.224552743
## StateKentucky 0.591020827 0.686996193
## StateLouisiana 0.292097065 0.394888461
## StateMaine -0.065746614 0.074857829
## StateMaryland -1.675419104 -1.451851831
## StateMassachusetts -0.302002541 -0.083062578
## StateMichigan -0.046464767 0.050576690
## StateMinnesota -0.754905369 -0.645251331
## StateMississippi -0.210742379 -0.087268616
## StateMissouri 0.085057722 0.185702542
## StateMontana -0.510770699 -0.394331541
## StateNebraska -1.018596137 -0.912234589
## StateNevada 0.384505286 0.495672978
## StateNew Hampshire 0.010674384 0.124591896
## StateNew Jersey -0.010708998 0.145727757
## StateNew Mexico 0.486968538 0.622210509
## StateNew York -0.252658248 -0.132279799
## StateNorth Carolina 0.186121130 0.274412387
## StateNorth Dakota -1.343680088 -1.172707883
## StateOhio 0.453871910 0.589151698
## StateOklahoma 0.336286341 0.453117480
## StateOregon -0.416865124 -0.299059866
## StatePennsylvania 0.559441441 0.677459526
## StateRhode Island -0.589873781 -0.312527565
## StateSouth Carolina 0.045203737 0.161134027
## StateSouth Dakota -1.218317372 -1.084870928
## StateTennessee 0.382305713 0.470729691
## StateTexas -0.033873294 0.087487525
## StateUtah -0.241196453 -0.054041819
## StateVermont -0.335254127 -0.191087648
## StateVirginia -0.069301461 0.031405848
## StateWashington -0.096970886 0.024086450
## StateWest Virginia 0.616272337 0.763862290
## StateWisconsin -0.041315108 0.055350995
## StateWyoming -0.158016158 -0.026862195
## Naloxone_Pharmacy_Yes_Redefined -0.126819690 -0.061319716
## Naloxone_Pharmacy_No_Redefined -0.061827052 0.003373398
## Medical_Marijuana_Redefined 0.129050881 0.199070518
## Recreational_Marijuana_Redefined -0.175467189 -0.098626529
## GSL_Redefined 0.007698979 0.063283495
## PDMP_Redefined -0.234541848 -0.178713621
## Medicaid_Expansion_Redefined 0.037370623 0.089195898
## neg_2_pd -0.092349592 0.020524738
## neg_3_pd -0.094755826 0.016757110
## neg_4_pd -0.131739932 -0.010783798
## neg_5_pd -0.130295904 -0.013004948
## neg_6_pd -0.117049085 -0.005778559
## neg_7_pd -0.160704646 -0.044021509
## neg_8_pd -0.245224820 -0.100544147
## neg_9_pd -0.182129446 -0.025158944
## neg_10_pd -0.118922597 0.024031356
## neg_11_pd -0.125372091 0.025412131
## neg_12_pd -0.050114192 0.115435529
## neg_13_pd -0.152868158 0.015177292
## neg_14_pd -0.174761759 -0.015729613
## neg_15_pd -0.248669745 -0.059495317
## neg_16_pd -0.217482729 -0.043767301
## neg_17_pd -0.213246323 -0.060151411
## neg_18_pd -0.196116002 -0.051908104
## neg_19_pd -0.386274566 -0.154364075
## neg_20_pd -0.449689904 -0.193711115
## neg_21_pd -0.299795811 -0.117692721
## neg_22_pd -0.287517173 -0.096423617
## neg_23_pd -0.402605591 -0.116590871
## neg_24_pd -0.522485297 -0.180864324
## neg_25_pd -0.325051268 -0.038788957
## neg_26_pd -0.306147219 0.044238456
## neg_27_pd -0.714236416 -0.213628304
## neg_28_pd -0.669383634 -0.201311333
## neg_29_pd -0.245517266 0.024088229
## neg_30_pd -0.307566464 -0.052096370
## neg_31_pd -0.277751718 -0.054179201
## neg_32_pd -0.179849349 0.032863102
## neg_33_pd -0.216537378 0.109007659
## pos_0_pd -0.119247683 -0.011149669
## pos_1_pd -0.155493502 -0.040113963
## pos_2_pd -0.110679260 -0.005207113
## pos_3_pd -0.149392401 -0.041493922
## pos_4_pd -0.155193824 -0.047126354
## pos_5_pd -0.201852471 -0.092045551
## pos_6_pd -0.211676132 -0.097121035
## pos_7_pd -0.214556474 -0.094523821
## pos_8_pd -0.254768298 -0.140578750
## pos_9_pd -0.281759585 -0.162175014
## pos_10_pd -0.306994676 -0.180016549
## pos_11_pd -0.302439201 -0.183783467
## pos_12_pd -0.317775638 -0.193795841
## pos_13_pd -0.402797602 -0.262320233
## pos_14_pd -0.387924786 -0.247335909
## pos_15_pd -0.387322987 -0.250438341
## pos_16_pd -0.409997721 -0.268524051
## pos_17_pd -0.406130067 -0.263061724
## pos_18_pd -0.400316748 -0.253663735
## pos_19_pd -0.385391286 -0.243608362
## pos_20_pd -0.398712925 -0.247582690
## pos_21_pd -0.434854946 -0.274332431
## pos_22_pd -0.424666741 -0.266749984
## pos_23_pd -0.439924967 -0.273338184
## pos_24_pd -0.487458699 -0.310854938
## pos_25_pd -0.475905008 -0.279921074
## pos_26_pd -0.481207255 -0.289983620
## pos_27_pd -0.541287653 -0.338308822
## pos_28_pd -0.530318463 -0.321207072
## pos_29_pd -0.554552376 -0.334408979
## pos_30_pd -0.513141915 -0.285008197
## pos_31_pd -0.496762582 -0.241545861
## pos_32_pd -0.548421385 -0.298666643
## pos_33_pd -0.636276686 -0.326206090
## pos_34_pd -0.633335400 -0.314276284
## pos_35_pd -0.790567646 -0.514644392
## pos_36_pd -0.805117655 -0.541250661
## pos_37_pd -0.781870141 -0.534987709
## pos_38_pd -0.755748754 -0.513830174
## pos_39_pd -0.844780244 -0.534088308
## s(Time_Period_ID):as.factor(Region)Midwest.1 -0.606300486 -0.494737079
## s(Time_Period_ID):as.factor(Region)Midwest.2 -0.313196740 -0.224608521
## s(Time_Period_ID):as.factor(Region)Midwest.3 0.005273923 0.093175900
## s(Time_Period_ID):as.factor(Region)Midwest.4 0.247618782 0.333711394
## s(Time_Period_ID):as.factor(Region)Midwest.5 0.429783397 0.513087394
## s(Time_Period_ID):as.factor(Region)Midwest.6 0.613350902 0.703168971
## s(Time_Period_ID):as.factor(Region)Midwest.7 0.809910433 0.903771029
## s(Time_Period_ID):as.factor(Region)Midwest.8 1.040189148 1.159056321
## s(Time_Period_ID):as.factor(Region)Midwest.9 0.970869551 1.099762557
## s(Time_Period_ID):as.factor(Region)Northeast.1 -0.858979108 -0.570605352
## s(Time_Period_ID):as.factor(Region)Northeast.2 -0.578240648 -0.351951731
## s(Time_Period_ID):as.factor(Region)Northeast.3 0.135544664 0.305946250
## s(Time_Period_ID):as.factor(Region)Northeast.4 0.069629519 0.234789810
## s(Time_Period_ID):as.factor(Region)Northeast.5 0.184484866 0.353117285
## s(Time_Period_ID):as.factor(Region)Northeast.6 0.438958937 0.593323854
## s(Time_Period_ID):as.factor(Region)Northeast.7 0.822062192 0.987559759
## s(Time_Period_ID):as.factor(Region)Northeast.8 1.245895974 1.424383187
## s(Time_Period_ID):as.factor(Region)Northeast.9 1.039238207 1.204455894
## s(Time_Period_ID):as.factor(Region)South.1 -0.486926536 -0.389922135
## s(Time_Period_ID):as.factor(Region)South.2 -0.208412768 -0.131694247
## s(Time_Period_ID):as.factor(Region)South.3 0.057708791 0.143187991
## s(Time_Period_ID):as.factor(Region)South.4 0.244212376 0.320084111
## s(Time_Period_ID):as.factor(Region)South.5 0.395655933 0.464161403
## s(Time_Period_ID):as.factor(Region)South.6 0.523618590 0.604633801
## s(Time_Period_ID):as.factor(Region)South.7 0.707913502 0.807908570
## s(Time_Period_ID):as.factor(Region)South.8 0.957313615 1.095942563
## s(Time_Period_ID):as.factor(Region)South.9 0.824688260 0.991245595
## s(Time_Period_ID):as.factor(Region)West.1 -0.428787038 -0.308386528
## s(Time_Period_ID):as.factor(Region)West.2 -0.225040794 -0.131400014
## s(Time_Period_ID):as.factor(Region)West.3 -0.021682692 0.069973226
## s(Time_Period_ID):as.factor(Region)West.4 0.154473915 0.230646763
## s(Time_Period_ID):as.factor(Region)West.5 0.275587256 0.357605994
## s(Time_Period_ID):as.factor(Region)West.6 0.374227506 0.468020533
## s(Time_Period_ID):as.factor(Region)West.7 0.467281938 0.566258884
## s(Time_Period_ID):as.factor(Region)West.8 0.602067415 0.719563215
## s(Time_Period_ID):as.factor(Region)West.9 0.585285435 0.704585511
## ub_coef sd_coef
## (Intercept) -9.485048518 0.06260554
## StateAlaska 0.252854392 0.07711180
## StateArizona 0.371278832 0.05785276
## StateArkansas -0.405537177 0.05637846
## StateCalifornia 0.072705071 0.06895691
## StateColorado 0.126689462 0.06338877
## StateConnecticut 0.357254117 0.06881462
## StateDelaware 0.291485448 0.06960167
## StateFlorida 0.533075637 0.06130157
## StateGeorgia 0.242851168 0.05879665
## StateHawaii -0.324024904 0.07302326
## StateIdaho -0.041208248 0.06013198
## StateIllinois 0.364093459 0.06658763
## StateIndiana 0.177104884 0.05154743
## StateIowa -0.514194525 0.05618284
## StateKansas -0.126845056 0.04985086
## StateKentucky 0.782971560 0.04896702
## StateLouisiana 0.497679858 0.05244459
## StateMaine 0.215462271 0.07173696
## StateMaryland -1.228284558 0.11406494
## StateMassachusetts 0.135877385 0.11170406
## StateMichigan 0.147618148 0.04951095
## StateMinnesota -0.535597293 0.05594594
## StateMississippi 0.036205147 0.06299682
## StateMissouri 0.286347363 0.05134940
## StateMontana -0.277892384 0.05940773
## StateNebraska -0.805873041 0.05426610
## StateNevada 0.606840670 0.05671821
## StateNew Hampshire 0.238509408 0.05812118
## StateNew Jersey 0.302164511 0.07981467
## StateNew Mexico 0.757452480 0.06900101
## StateNew York -0.011901350 0.06141758
## StateNorth Carolina 0.362703644 0.04504656
## StateNorth Dakota -1.001735677 0.08723072
## StateOhio 0.724431486 0.06902030
## StateOklahoma 0.569948619 0.05960772
## StateOregon -0.181254607 0.06010472
## StatePennsylvania 0.795477611 0.06021331
## StateRhode Island -0.035181348 0.14150317
## StateSouth Carolina 0.277064316 0.05914811
## StateSouth Dakota -0.951424485 0.06808492
## StateTennessee 0.559153670 0.04511427
## StateTexas 0.208848344 0.06191879
## StateUtah 0.133112815 0.09548706
## StateVermont -0.046921170 0.07355433
## StateVirginia 0.132113157 0.05138128
## StateWashington 0.145143787 0.06176395
## StateWest Virginia 0.911452242 0.07530100
## StateWisconsin 0.152017097 0.04931944
## StateWyoming 0.104291768 0.06691529
## Naloxone_Pharmacy_Yes_Redefined 0.004180259 0.03341835
## Naloxone_Pharmacy_No_Redefined 0.068573849 0.03326554
## Medical_Marijuana_Redefined 0.269090156 0.03572430
## Recreational_Marijuana_Redefined -0.021785870 0.03920442
## GSL_Redefined 0.118868012 0.02835945
## PDMP_Redefined -0.122885394 0.02848379
## Medicaid_Expansion_Redefined 0.141021172 0.02644147
## neg_2_pd 0.133399068 0.05758894
## neg_3_pd 0.128270046 0.05689435
## neg_4_pd 0.110172337 0.06171231
## neg_5_pd 0.104286007 0.05984232
## neg_6_pd 0.105491968 0.05677068
## neg_7_pd 0.072661628 0.05953221
## neg_8_pd 0.044136525 0.07381667
## neg_9_pd 0.131811558 0.08008699
## neg_10_pd 0.166985310 0.07293569
## neg_11_pd 0.176196353 0.07693073
## neg_12_pd 0.280985250 0.08446414
## neg_13_pd 0.183222741 0.08573747
## neg_14_pd 0.143302533 0.08113885
## neg_15_pd 0.129679111 0.09651757
## neg_16_pd 0.129948127 0.08863032
## neg_17_pd 0.092943501 0.07810965
## neg_18_pd 0.092299794 0.07357546
## neg_19_pd 0.077546416 0.11832168
## neg_20_pd 0.062267675 0.13060142
## neg_21_pd 0.064410369 0.09290974
## neg_22_pd 0.094669940 0.09749671
## neg_23_pd 0.169423848 0.14592588
## neg_24_pd 0.160756649 0.17429641
## neg_25_pd 0.247473355 0.14605220
## neg_26_pd 0.394624131 0.17876820
## neg_27_pd 0.286979809 0.25541230
## neg_28_pd 0.266760967 0.23881240
## neg_29_pd 0.293693724 0.13755382
## neg_30_pd 0.203373723 0.13034188
## neg_31_pd 0.169393317 0.11406761
## neg_32_pd 0.245575554 0.10852676
## neg_33_pd 0.434552697 0.16609441
## pos_0_pd 0.096948344 0.05515205
## pos_1_pd 0.075265577 0.05886711
## pos_2_pd 0.100265034 0.05381232
## pos_3_pd 0.066404557 0.05505024
## pos_4_pd 0.060941117 0.05513646
## pos_5_pd 0.017761369 0.05602394
## pos_6_pd 0.017434062 0.05844648
## pos_7_pd 0.025508832 0.06124115
## pos_8_pd -0.026389202 0.05825997
## pos_9_pd -0.042590442 0.06101254
## pos_10_pd -0.053038422 0.06478476
## pos_11_pd -0.065127733 0.06053864
## pos_12_pd -0.069816043 0.06325500
## pos_13_pd -0.121842865 0.07167213
## pos_14_pd -0.106747033 0.07172902
## pos_15_pd -0.113553695 0.06983911
## pos_16_pd -0.127050380 0.07218044
## pos_17_pd -0.119993382 0.07299405
## pos_18_pd -0.107010723 0.07482297
## pos_19_pd -0.101825438 0.07233823
## pos_20_pd -0.096452455 0.07710726
## pos_21_pd -0.113809917 0.08189924
## pos_22_pd -0.108833226 0.08056977
## pos_23_pd -0.106751400 0.08499326
## pos_24_pd -0.134251176 0.09010396
## pos_25_pd -0.083937141 0.09999180
## pos_26_pd -0.098759986 0.09756308
## pos_27_pd -0.135329992 0.10356063
## pos_28_pd -0.112095682 0.10668949
## pos_29_pd -0.114265581 0.11231806
## pos_30_pd -0.056874479 0.11639475
## pos_31_pd 0.013670859 0.13021261
## pos_32_pd -0.048911901 0.12742589
## pos_33_pd -0.016135493 0.15819928
## pos_34_pd 0.004782832 0.16278526
## pos_35_pd -0.238721139 0.14077717
## pos_36_pd -0.277383666 0.13462602
## pos_37_pd -0.288105278 0.12596042
## pos_38_pd -0.271911593 0.12342785
## pos_39_pd -0.223396372 0.15851629
## s(Time_Period_ID):as.factor(Region)Midwest.1 -0.383173672 0.05692011
## s(Time_Period_ID):as.factor(Region)Midwest.2 -0.136020302 0.04519807
## s(Time_Period_ID):as.factor(Region)Midwest.3 0.181077878 0.04484795
## s(Time_Period_ID):as.factor(Region)Midwest.4 0.419804007 0.04392480
## s(Time_Period_ID):as.factor(Region)Midwest.5 0.596391391 0.04250204
## s(Time_Period_ID):as.factor(Region)Midwest.6 0.792987040 0.04582555
## s(Time_Period_ID):as.factor(Region)Midwest.7 0.997631624 0.04788806
## s(Time_Period_ID):as.factor(Region)Midwest.8 1.277923493 0.06064652
## s(Time_Period_ID):as.factor(Region)Midwest.9 1.228655562 0.06576174
## s(Time_Period_ID):as.factor(Region)Northeast.1 -0.282231597 0.14712947
## s(Time_Period_ID):as.factor(Region)Northeast.2 -0.125662815 0.11545353
## s(Time_Period_ID):as.factor(Region)Northeast.3 0.476347836 0.08693958
## s(Time_Period_ID):as.factor(Region)Northeast.4 0.399950100 0.08426545
## s(Time_Period_ID):as.factor(Region)Northeast.5 0.521749703 0.08603695
## s(Time_Period_ID):as.factor(Region)Northeast.6 0.747688772 0.07875761
## s(Time_Period_ID):as.factor(Region)Northeast.7 1.153057326 0.08443753
## s(Time_Period_ID):as.factor(Region)Northeast.8 1.602870399 0.09106490
## s(Time_Period_ID):as.factor(Region)Northeast.9 1.369673580 0.08429474
## s(Time_Period_ID):as.factor(Region)South.1 -0.292917733 0.04949204
## s(Time_Period_ID):as.factor(Region)South.2 -0.054975725 0.03914210
## s(Time_Period_ID):as.factor(Region)South.3 0.228667190 0.04361184
## s(Time_Period_ID):as.factor(Region)South.4 0.395955845 0.03871007
## s(Time_Period_ID):as.factor(Region)South.5 0.532666874 0.03495177
## s(Time_Period_ID):as.factor(Region)South.6 0.685649013 0.04133429
## s(Time_Period_ID):as.factor(Region)South.7 0.907903637 0.05101789
## s(Time_Period_ID):as.factor(Region)South.8 1.234571510 0.07072905
## s(Time_Period_ID):as.factor(Region)South.9 1.157802930 0.08497823
## s(Time_Period_ID):as.factor(Region)West.1 -0.187986018 0.06142883
## s(Time_Period_ID):as.factor(Region)West.2 -0.037759235 0.04777591
## s(Time_Period_ID):as.factor(Region)West.3 0.161629143 0.04676322
## s(Time_Period_ID):as.factor(Region)West.4 0.306819612 0.03886370
## s(Time_Period_ID):as.factor(Region)West.5 0.439624731 0.04184629
## s(Time_Period_ID):as.factor(Region)West.6 0.561813560 0.04785359
## s(Time_Period_ID):as.factor(Region)West.7 0.665235830 0.05049844
## s(Time_Period_ID):as.factor(Region)West.8 0.837059016 0.05994684
## s(Time_Period_ID):as.factor(Region)West.9 0.823885587 0.06086739# write.csv(format(round(sensitivity_anlys_event_study_sd_and_ci, 3), nsmall = 3), "./Data/event_study_coef_and_ci.csv")6.4.3 Plot Results
#plot the coefficients for the periods before and after the intervention with 95% CI
plot_event_study_log_smoothed_time <- sensitivity_anlys_event_study_sd_and_ci_log_smoothed_time %>%
mutate(term = rownames(sensitivity_anlys_event_study_sd_and_ci_log_smoothed_time)) %>%
dplyr::select(term, coef_values, lb_coef, ub_coef) %>%
filter(term %in% c(sapply(2:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 2),
function(x){paste("neg_", x, "_pd", sep = "")}),
sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x){paste("pos_", x, "_pd", sep = "")})))
colnames(plot_event_study_log_smoothed_time) <- c("term", "estimate", "conf.low", "conf.high")
dwplot(plot_event_study_log_smoothed_time, colour = "black",
vars_order = c(sapply((max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)):0,
function(x){paste("pos_", x, "_pd", sep = "")}),
sapply(2:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 2),
function(x){paste("neg_", x, "_pd", sep = "")}))) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(angle = 45)) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Time Relative to Time of Treatment",
x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Pre-Intervention and Post-Intervention Periods") +
scale_color_grey() +
coord_flip() +
geom_hline(yintercept = 33, col = "red", linetype = "dashed")
plot_event_study_log_smoothed_time_paper <- plot_event_study_log_smoothed_time
plot_event_study_log_smoothed_time_paper$term <- ifelse(grepl("pos_", plot_event_study_log_smoothed_time_paper$term),
paste("+", extract_numeric(plot_event_study_log_smoothed_time_paper$term),
sep = ""),
paste("-", extract_numeric(plot_event_study_log_smoothed_time_paper$term),
sep = ""))
pdf("./Figures/pre_tx_trend_ols_model_5_9_22.pdf")
dwplot(plot_event_study_log_smoothed_time_paper, colour = "black",
vars_order = c(sapply((max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)):0,
function(x){paste("+", x, sep = "")}),
sapply(2:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 2),
function(x){paste("-", x, sep = "")}))) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(size = 5, angle = 45)) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Time Relative to Time of Treatment",
x = "Coefficients and 95% Confidence Intervals") +
scale_color_grey() +
coord_flip() +
geom_hline(yintercept = 33, col = "red", linetype = "dashed")
dev.off()## quartz_off_screen
## 26.4.4 Bootstrapping: Coefficient and Attributable Death Estimate
bootstrap_smoothed_eff_log_outcome_event_study <- boostrap_state_time(sensitivity_anlys_event_study_data,
sensitivity_anlys_event_study_model_log_smoothed_time,
lin_model = FALSE)
reduced_coef_event_study <- Reduce("cbind", bootstrap_smoothed_eff_log_outcome_event_study[[1]])
coef_w_ci <- cbind(t(apply(reduced_coef_event_study, 1, quantile, probs = c(.025, .975))), apply(reduced_coef_event_study, 1, mean))
colnames(coef_w_ci) <- c("conf.low", "conf.high", "estimate")
coef_w_ci <- data.frame(coef_w_ci)
coef_w_ci$term <- rownames(coef_w_ci)
dwplot(coef_w_ci, colour = "black",
vars_order = c(sapply((max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)):0,
function(x){paste("pos_", x, "_pd", sep = "")}),
sapply(2:(max(merged_main_time_data_int$intervention_time_id, na.rm = TRUE) - 2),
function(x){paste("neg_", x, "_pd", sep = "")}))) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(angle = 45)) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Time", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Pre-Intervention and Post-Intervention Periods, Using Bootstrap") +
scale_color_grey() +
coord_flip() +
geom_hline(yintercept = 33, col = "red", linetype = "dashed")6.5 Analysis With Only Periods After Treatment
formula_post_tx_log_smoothed_time <- formula(paste("log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
Naloxone_Pharmacy_No_Redefined +
Medical_Marijuana_Redefined +
Recreational_Marijuana_Redefined +
GSL_Redefined +
PDMP_Redefined +
Medicaid_Expansion_Redefined +",
paste(sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x)paste("pos_", x, "_pd", sep = "")), collapse = "+")))
#run the gam model
sensitivity_anlys_post_tx_model_log_smoothed_time<-gam(formula_post_tx_log_smoothed_time,
data = sensitivity_anlys_event_study_data)
# summary(sensitivity_anlys_post_tx_model_log_smoothed_time)6.5.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time <-
data.frame(predict(sensitivity_anlys_post_tx_model_log_smoothed_time, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_post_tx_log_smoothed_time <- coef(sensitivity_anlys_post_tx_model_log_smoothed_time)
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time),
log(sensitivity_anlys_event_study_data$prop_dead),
coefficient_values_sensitivity_anlys_post_tx_log_smoothed_time,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time))
# sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time6.5.2 Plot Results
#plot the coefficients for the periods before and after the intervention with 95% CI
plot_post_tx_log_smoothed_time <- sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time %>%
mutate(term = rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time)) %>%
dplyr::select(term, coef_values, lb_coef, ub_coef) %>%
filter(term %in% c(sapply(0:(max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)),
function(x){paste("pos_", x, "_pd", sep = "")})))
colnames(plot_post_tx_log_smoothed_time) <- c("term", "estimate", "conf.low", "conf.high")
plot_post_tx_log_smoothed_time$num_states <- sapply(plot_post_tx_log_smoothed_time$term,
function(x){sum(sensitivity_anlys_event_study_data[,x])})
dwplot(plot_post_tx_log_smoothed_time, colour = "black",
vars_order = c(sapply(((max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)):0),
function(x){paste("pos_", x, "_pd", sep = "")}))) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(angle = 45, size = 4)) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Time Periods", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Post-Intervention Periods") +
scale_color_grey() +
coord_flip() 
# geom_vline(aes(xintercept = coef(main_analysis_model_log_smoothed_time)["Intervention_Redefined"]), linetype = "dashed", color = "red") +
# geom_text(aes(label = paste("Coefficient Estimate: ", coef(main_analysis_model_log_smoothed_time)["Intervention_Redefined"]), y = 12,
# x = coef(main_analysis_model_log_smoothed_time)["Intervention_Redefined"] + 0.1), color = "red")
# geom_text(aes(label = num_states, x = .1, y = 40:1), size = 2)6.5.3 Attributable Deaths
date_data <- sensitivity_anlys_event_study_data[, c("Time_Period_ID", "Time_Period_Start")]
date_data <- date_data[!duplicated(date_data),]
colnames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time) <- c("conf.low", "estimate", "conf.high", "sd")
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time$term <- rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time)
attr_deaths_est_log_smoothed_time_post <- attr_death_compute(sensitivity_anlys_event_study_data,
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time,
lin_model = FALSE)
attr_deaths_est_log_smoothed_time_post <- merge(attr_deaths_est_log_smoothed_time_post, date_data,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_log_smoothed_time_post, aes(x = Time_Period_Start)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Event Study",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
6.6 Bootstrapping: Coefficient and Attributable Death Estimate
bootstrap_smoothed_eff_log_outcome_post_tx <- boostrap_state_time(sensitivity_anlys_event_study_data,
sensitivity_anlys_post_tx_model_log_smoothed_time,
lin_model = FALSE)
reduced_coef_outcome_post_tx <- Reduce("cbind", bootstrap_smoothed_eff_log_outcome_post_tx[[1]])
coef_w_ci_smoothed_time_log_outcome_post_tx <- cbind(t(apply(reduced_coef_outcome_post_tx, 1, quantile, probs = c(.025, .975))),
apply(reduced_coef_outcome_post_tx, 1, mean))
colnames(coef_w_ci_smoothed_time_log_outcome_post_tx) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_log_outcome_post_tx <- data.frame(coef_w_ci_smoothed_time_log_outcome_post_tx)
coef_w_ci_smoothed_time_log_outcome_post_tx$term <- rownames(coef_w_ci_smoothed_time_log_outcome_post_tx)
dwplot(coef_w_ci_smoothed_time_log_outcome_post_tx, colour = "black",
vars_order = c(sapply((max(merged_main_time_data_int$Time_Period_ID) -
min(merged_main_time_data_int$intervention_time_id, na.rm = TRUE)):0,
function(x){paste("pos_", x, "_pd", sep = "")}))) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(angle = 45)) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Time", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Post-Intervention Periods, Using Bootstrap") +
scale_color_grey() +
coord_flip()
list_attr_deaths_post_tx <- lapply(bootstrap_smoothed_eff_log_outcome_post_tx[[2]], function(x){x$attr_deaths})
reduced_attr_deaths_post_tx <- Reduce("cbind", list_attr_deaths_post_tx)
attr_deaths_smoothed_time_post_tx <- cbind(t(apply(reduced_attr_deaths_post_tx, 1, quantile, probs = c(.025, .975), na.rm = TRUE)),
apply(reduced_attr_deaths_post_tx, 1, mean, na.rm = TRUE))
colnames(attr_deaths_smoothed_time_post_tx) <- c("conf.low", "conf.high", "estimate")
attr_deaths_smoothed_time_post_tx <- data.frame(attr_deaths_smoothed_time_post_tx)
attr_deaths_smoothed_time_post_tx$Time_Period_Start <- unique(main_analysis_data$Time_Period_Start)
ggplot(attr_deaths_smoothed_time_post_tx, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = estimate, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Estimated Using Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))6.6.1 Model With Semi Dynamic Regression
coef_semi_dynamic <- data.frame(matrix(NA, nrow = 40, ncol = 4))
for(time in 0:39){
subset_data <- sensitivity_anlys_event_study_data %>%
filter(get(paste("pos_", time, "_pd", sep = "")) == 1 |
Time_Period_Start <= Intervention_First_Date)
formula_semi_dynamic <- formula(paste("log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
Naloxone_Pharmacy_No_Redefined +
Medical_Marijuana_Redefined +
Recreational_Marijuana_Redefined +
GSL_Redefined +
PDMP_Redefined +
Medicaid_Expansion_Redefined +",
paste("pos_", time, "_pd", sep = "")))
#run the gam model
semi_dynamic_model<-gam(formula_semi_dynamic, data = subset_data)
summary_semi_dynamic_model <- summary(semi_dynamic_model)
sd_semi_dynamic_model <- summary_semi_dynamic_model$se[paste("pos_", time, "_pd", sep = "")]
coef_value <- coef(semi_dynamic_model)[paste("pos_", time, "_pd", sep = "")]
coef_semi_dynamic[time + 1,] <- c(time, coef_value, coef_value - 1.96*sd_semi_dynamic_model, coef_value + 1.96*sd_semi_dynamic_model)
}
colnames(coef_semi_dynamic) <- c("time_after_tx", "estimate", "lb", "ub")
ggplot(coef_semi_dynamic, aes(y = estimate, x = time_after_tx)) +
geom_pointrange(aes(ymin = lb, ymax = ub), fatten = 1)6.7 Analysis With Linear Effects Periods After Treatment
#use this function to compute the cumulative sum, but resets the sum if the variable was 0
compute_cumsum = function(x){
cs = cumsum(x)
cs - cummax((x == 0) * cs)
}
sensitivity_anlys_event_study_data_lin_post_tx <- sensitivity_anlys_event_study_data %>%
arrange(State, Time_Period_ID) %>%
group_by(State) %>%
mutate(sum_tx_periods = pos_0_pd + pos_1_pd + pos_2_pd + pos_3_pd +
pos_4_pd + pos_5_pd + pos_6_pd + pos_7_pd + pos_8_pd + pos_9_pd +
pos_10_pd + pos_11_pd + pos_12_pd + pos_13_pd + pos_14_pd +
pos_15_pd + pos_16_pd + pos_17_pd + pos_18_pd + pos_19_pd +
pos_20_pd + pos_21_pd + pos_22_pd + pos_23_pd + pos_24_pd +
pos_25_pd + pos_26_pd + pos_27_pd + pos_28_pd + pos_29_pd +
pos_30_pd + pos_31_pd + pos_32_pd + pos_33_pd + pos_34_pd +
pos_35_pd + pos_36_pd + pos_37_pd + pos_38_pd + pos_39_pd,
time_after_tx = cumsum(sum_tx_periods),
num_pd_w_tx = compute_cumsum(Intervention_Redefined ),
num_pd_w_naloxone_yes = compute_cumsum(Naloxone_Pharmacy_Yes_Redefined),
num_pd_w_naloxone_no = compute_cumsum(Naloxone_Pharmacy_No_Redefined),
num_pd_w_med_marijuana = compute_cumsum(Medical_Marijuana_Redefined),
num_pd_w_rec_marijuana = compute_cumsum(Recreational_Marijuana_Redefined),
num_pd_w_gsl = compute_cumsum(GSL_Redefined),
num_pd_w_pdmp = compute_cumsum(PDMP_Redefined),
num_pd_w_medicaid = compute_cumsum(Medicaid_Expansion_Redefined),
lag_num_pd_w_tx = lag(num_pd_w_tx),
lag_num_pd_w_naloxone_yes = lag(num_pd_w_naloxone_yes),
lag_num_pd_w_naloxone_no = lag(num_pd_w_naloxone_no),
lag_num_pd_w_med_marijuana = lag(num_pd_w_med_marijuana),
lag_num_pd_w_rec_marijuana = lag(num_pd_w_rec_marijuana),
lag_num_pd_w_gsl = lag(num_pd_w_gsl),
lag_num_pd_w_pdmp = lag(num_pd_w_pdmp),
lag_num_pd_w_medicaid = lag(num_pd_w_medicaid)) #lag so that intercept = effect when tx first occurs
#fill in a 0 for the NAs so we keep all the data and at most this will be 0
#also fill in a 0 for the linear effect of intervention for the first period
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_tx[
sensitivity_anlys_event_study_data_lin_post_tx$Intervention_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_naloxone_yes[
sensitivity_anlys_event_study_data_lin_post_tx$Naloxone_Pharmacy_Yes_Redefined < 1]<-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_naloxone_no[
sensitivity_anlys_event_study_data_lin_post_tx$Naloxone_Pharmacy_No_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_med_marijuana[
sensitivity_anlys_event_study_data_lin_post_tx$Medical_Marijuana_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_rec_marijuana[
sensitivity_anlys_event_study_data_lin_post_tx$Recreational_Marijuana_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_gsl[
sensitivity_anlys_event_study_data_lin_post_tx$GSL_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_pdmp[
sensitivity_anlys_event_study_data_lin_post_tx$PDMP_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx$lag_num_pd_w_medicaid[
sensitivity_anlys_event_study_data_lin_post_tx$Medicaid_Expansion_Redefined < 1] <-0
#run the gam model
sensitivity_anlys_lin_post_tx_model_log_smoothed_time<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
Intervention_Redefined +
lag_num_pd_w_tx,
data = sensitivity_anlys_event_study_data_lin_post_tx)
summary(sensitivity_anlys_lin_post_tx_model_log_smoothed_time)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + lag_num_pd_w_naloxone_yes +
## Naloxone_Pharmacy_No_Redefined + lag_num_pd_w_naloxone_no +
## Medical_Marijuana_Redefined + lag_num_pd_w_med_marijuana +
## Recreational_Marijuana_Redefined + lag_num_pd_w_rec_marijuana +
## GSL_Redefined + lag_num_pd_w_gsl + PDMP_Redefined + lag_num_pd_w_pdmp +
## Medicaid_Expansion_Redefined + lag_num_pd_w_medicaid + Intervention_Redefined +
## lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.678941 0.062382 -155.157 < 2e-16 ***
## StateAlaska 0.177343 0.083697 2.119 0.034231 *
## StateArizona 0.264886 0.066237 3.999 6.60e-05 ***
## StateArkansas -0.502592 0.067334 -7.464 1.27e-13 ***
## StateCalifornia 0.015999 0.086296 0.185 0.852935
## StateColorado 0.077989 0.078766 0.990 0.322234
## StateConnecticut 0.263003 0.072140 3.646 0.000274 ***
## StateDelaware 0.179210 0.068643 2.611 0.009106 **
## StateFlorida 0.469682 0.068570 6.850 9.97e-12 ***
## StateGeorgia 0.234711 0.070717 3.319 0.000921 ***
## StateHawaii -0.412978 0.086070 -4.798 1.73e-06 ***
## StateIdaho -0.263980 0.070067 -3.768 0.000170 ***
## StateIllinois 0.273254 0.074076 3.689 0.000232 ***
## StateIndiana -0.016469 0.068716 -0.240 0.810617
## StateIowa -0.613142 0.064686 -9.479 < 2e-16 ***
## StateKansas -0.194721 0.064205 -3.033 0.002456 **
## StateKentucky 0.595200 0.069329 8.585 < 2e-16 ***
## StateLouisiana 0.421595 0.064054 6.582 6.00e-11 ***
## StateMaine 0.219451 0.083298 2.635 0.008495 **
## StateMaryland -1.406348 0.070417 -19.972 < 2e-16 ***
## StateMassachusetts -0.143408 0.069758 -2.056 0.039939 *
## StateMichigan 0.008286 0.072491 0.114 0.909009
## StateMinnesota -0.559234 0.070624 -7.918 4.06e-15 ***
## StateMississippi -0.130853 0.063894 -2.048 0.040700 *
## StateMissouri 0.300737 0.073666 4.082 4.64e-05 ***
## StateMontana -0.225004 0.074970 -3.001 0.002724 **
## StateNebraska -0.903276 0.067623 -13.358 < 2e-16 ***
## StateNevada 0.535619 0.081555 6.568 6.59e-11 ***
## StateNew Hampshire 0.177163 0.068298 2.594 0.009561 **
## StateNew Jersey 0.227583 0.067883 3.353 0.000816 ***
## StateNew Mexico 0.684644 0.078563 8.715 < 2e-16 ***
## StateNew York -0.220508 0.070836 -3.113 0.001880 **
## StateNorth Carolina 0.307306 0.063646 4.828 1.49e-06 ***
## StateNorth Dakota -1.208449 0.064240 -18.811 < 2e-16 ***
## StateOhio 0.617865 0.068359 9.039 < 2e-16 ***
## StateOklahoma 0.367308 0.069080 5.317 1.18e-07 ***
## StateOregon -0.092079 0.081816 -1.125 0.260549
## StatePennsylvania 0.639060 0.072385 8.829 < 2e-16 ***
## StateRhode Island -0.312299 0.074771 -4.177 3.09e-05 ***
## StateSouth Carolina 0.126318 0.064639 1.954 0.050825 .
## StateSouth Dakota -1.077450 0.067181 -16.038 < 2e-16 ***
## StateTennessee 0.455862 0.063531 7.175 1.03e-12 ***
## StateTexas 0.065809 0.071916 0.915 0.360265
## StateUtah -0.115434 0.069154 -1.669 0.095236 .
## StateVermont -0.091676 0.070121 -1.307 0.191236
## StateVirginia 0.018175 0.065608 0.277 0.781792
## StateWashington 0.107278 0.080482 1.333 0.182707
## StateWest Virginia 0.656607 0.069869 9.398 < 2e-16 ***
## StateWisconsin 0.106853 0.066196 1.614 0.106655
## StateWyoming -0.069148 0.063912 -1.082 0.279425
## Naloxone_Pharmacy_Yes_Redefined -0.040959 0.041733 -0.981 0.326494
## lag_num_pd_w_naloxone_yes -0.027003 0.006588 -4.099 4.33e-05 ***
## Naloxone_Pharmacy_No_Redefined 0.129651 0.043251 2.998 0.002756 **
## lag_num_pd_w_naloxone_no -0.022777 0.004517 -5.043 5.03e-07 ***
## Medical_Marijuana_Redefined 0.192279 0.030305 6.345 2.78e-10 ***
## lag_num_pd_w_med_marijuana -0.008505 0.002213 -3.843 0.000125 ***
## Recreational_Marijuana_Redefined -0.015978 0.061129 -0.261 0.793829
## lag_num_pd_w_rec_marijuana -0.008431 0.010880 -0.775 0.438514
## GSL_Redefined 0.071508 0.032779 2.182 0.029267 *
## lag_num_pd_w_gsl 0.010557 0.004060 2.600 0.009388 **
## PDMP_Redefined -0.128942 0.027146 -4.750 2.19e-06 ***
## lag_num_pd_w_pdmp 0.006260 0.002417 2.590 0.009666 **
## Medicaid_Expansion_Redefined 0.076951 0.033493 2.298 0.021699 *
## lag_num_pd_w_medicaid 0.012902 0.004989 2.586 0.009776 **
## Intervention_Redefined -0.044881 0.023857 -1.881 0.060090 .
## lag_num_pd_w_tx -0.013751 0.001782 -7.715 1.94e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 4.133 5.113 97.54 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.398 8.897 49.05 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 6.219 7.377 55.25 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 4.386 5.424 37.09 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.852 Deviance explained = 85.8%
## GCV = 0.082 Scale est. = 0.078309 n = 1980plot(sensitivity_anlys_lin_post_tx_model_log_smoothed_time, pages = 1)
6.7.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_log_smoothed_time <-
data.frame(predict(sensitivity_anlys_lin_post_tx_model_log_smoothed_time, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_lin_post_tx_log_smoothed_time <- coef(sensitivity_anlys_lin_post_tx_model_log_smoothed_time)
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time_w_cov <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_log_smoothed_time),
log(sensitivity_anlys_event_study_data$prop_dead),
coefficient_values_sensitivity_anlys_lin_post_tx_log_smoothed_time,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_log_smoothed_time),
print_full_cov = TRUE)
# format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time, 3), nsmall = 3)
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time <- sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time_w_cov[[1]]
colnames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time) <- c("conf.low", "estimate", "conf.high", "sd")
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term <- rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time)
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$ci_95 <-
paste("95% CI = (", format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low, 3), nsmall = 3), ", ",
format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Linear Intervention") +
scale_color_grey() +
geom_text(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_log_all_yr <- sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,]
table_of_RR_lin_eff_log_all_yr$estimate <- round(exp(table_of_RR_lin_eff_log_all_yr$estimate), 3)
table_of_RR_lin_eff_log_all_yr$conf.low <- exp(table_of_RR_lin_eff_log_all_yr$conf.low)
table_of_RR_lin_eff_log_all_yr$conf.high <- exp(table_of_RR_lin_eff_log_all_yr$conf.high)
table_of_RR_lin_eff_log_all_yr$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_log_all_yr$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_log_all_yr$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_log_all_yr, "./Data/table_of_RR_lin_eff_log_all_yr_5_9_22.csv")6.7.2 Attributable Deaths
date_data <- sensitivity_anlys_event_study_data_lin_post_tx[, c("Time_Period_ID", "Time_Period_Start")]
date_data <- date_data[!duplicated(date_data),]
var_cov_mat_beta_lin_tx <- as.matrix(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time_w_cov[[2]][
c("Intervention_Redefined", "lag_num_pd_w_tx"), c("Intervention_Redefined", "lag_num_pd_w_tx")])
attr_deaths_est_log_smoothed_time_lin_post <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx,
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"),
var_cov_mat_beta_lin_tx)
attr_deaths_est_log_smoothed_time_lin_post <- merge(attr_deaths_est_log_smoothed_time_lin_post, date_data,
by.x = "Time_Period", by.y = "Time_Period_ID")
attr_deaths_est_log_smoothed_time_lin_post_summary <- attr_deaths_est_log_smoothed_time_lin_post %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_attr_deaths = sum(attr_deaths),
total_attr_deaths_lb = sum(attr_deaths_lb),
total_attr_deaths_ub = sum(attr_deaths_ub))
ggplot(attr_deaths_est_log_smoothed_time_lin_post_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year,
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
#overall national overdose deaths
national_od <- sensitivity_anlys_event_study_data_lin_post_tx %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_od = sum(imputed_deaths),
total_od_prob = sum(imputed_deaths)/sum(population),
total_pop = sum(population))
national_od <- merge(national_od, attr_deaths_est_log_smoothed_time_lin_post_summary, by = "year")
ggplot(national_od, aes(x = year)) +
geom_line(aes(y = total_od, color = "Oberved OD")) +
geom_line(aes(y = total_attr_deaths, color = "Lives Saved", linetype = "Estimate")) +
geom_line(aes(y = total_attr_deaths_lb, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths_ub, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths + total_od,
color = "Potential Number of Deaths Had There Not Been DIH Prosecutions")) +
labs(x = "Date", y = "People",
title = "Number of OD Deaths and Estimated Number of Lives Saved in Each Year",
color = "", linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid")) +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
pdf("./Figures/lives_saved_ols_lin_tx_all_time_5_9_22.pdf")
ggplot(attr_deaths_est_log_smoothed_time_lin_post_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Year", y = "Lives Saved",
# title = "Estimated Number of Lives Saved Per Year,
# Using Smoothed Time Effects,
# Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = c(.3, .8)) +
scale_linetype_manual(values = c("dashed", "solid"))
dev.off()## quartz_off_screen
## 2pdf("./Figures/lives_saved_and_est_od_ols_lin_tx_all_time_5_9_22.pdf")
ggplot(national_od, aes(x = year)) +
geom_line(aes(y = total_od, color = "Oberved OD")) +
geom_line(aes(y = total_attr_deaths, color = "Lives Saved", linetype = "Estimate")) +
geom_line(aes(y = total_attr_deaths_lb, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths_ub, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths + total_od,
color = "Potential Number of Deaths Had There Not Been DIH Prosecutions")) +
labs(x = "Date", y = "People",
# title = "Number of OD Deaths and Estimated Number of Lives Saved in Each Year",
color = "", linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid")) +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
dev.off()## quartz_off_screen
## 26.7.3 Bootstrapping: Coefficient and Attributable Death Estimate
6.7.3.1 Clustered
bootstrap_smoothed_eff_log_outcome_lin_post_tx <- boostrap_state_time_group(sensitivity_anlys_event_study_data_lin_post_tx,
sensitivity_anlys_lin_post_tx_model_log_smoothed_time,
coef_of_interest = rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,]),
nSim = 5000)
colnames(bootstrap_smoothed_eff_log_outcome_lin_post_tx) <- rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,])
# write.csv(bootstrap_smoothed_eff_log_outcome_lin_post_tx,
# "./Data/all_clustered_bootstrap_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
# row.names = FALSE)
mean_coef_outcome_lin_post_tx <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx, 2, mean)
ci_coef_outcome_lin_post_tx <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx, 2, quantile, probs = c(.025, .975))
coef_w_ci_smoothed_time_log_outcome_lin_post_tx <- cbind(t(ci_coef_outcome_lin_post_tx),
mean_coef_outcome_lin_post_tx)
colnames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx <- data.frame(coef_w_ci_smoothed_time_log_outcome_lin_post_tx)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx$ci_95 <- paste("95% CI = (",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx$conf.low, 3),
nsmall = 3),
",",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx$conf.high,3),
nsmall = 3),
")", sep = "")
# write.csv(coef_w_ci_smoothed_time_log_outcome_lin_post_tx,
# "./Data/clustered_bootstrap_summary_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
# row.names = FALSE)coef_w_ci_smoothed_time_log_outcome_lin_post_tx <-
read.csv("./Data/clustered_bootstrap_summary_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
row.names = "term")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx)
#multiply coefficients by 10 if they're the linear effects
ten_pd_eff <- coef_w_ci_smoothed_time_log_outcome_lin_post_tx[rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
ten_pd_eff$estimate <- ten_pd_eff$estimate*10
ten_pd_eff$conf.high <- ten_pd_eff$conf.high*10
ten_pd_eff$conf.low <- ten_pd_eff$conf.low*10
ten_pd_eff$ci_95 <- paste("95% CI = (", format(round(ten_pd_eff$conf.low, 3), nsmall = 3), ", ", format(round(ten_pd_eff$conf.high, 3),
nsmall = 3), ")", sep = "")
rownames(ten_pd_eff) <- ten_pd_eff$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_df <- rbind(coef_w_ci_smoothed_time_log_outcome_lin_post_tx, ten_pd_eff)
combined_ten_pd_df_to_be_combined <- combined_ten_pd_df %>%
filter(!(term %in% c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx")))
#put model estimates in the plot
model_effect_estimates <- sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,]
model_effect_estimates_to_be_combined <- model_effect_estimates[
!rownames(model_effect_estimates) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
combined_ten_pd_model_est <- sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[
rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
rownames(combined_ten_pd_model_est) <- combined_ten_pd_model_est$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_model_est$estimate <- combined_ten_pd_model_est$estimate*10
combined_ten_pd_model_est$conf.low <- combined_ten_pd_model_est$conf.low*10
combined_ten_pd_model_est$conf.high <- combined_ten_pd_model_est$conf.high*10
combined_ten_pd_model_est$ci_95 <- paste("95% CI = (",
format(round(combined_ten_pd_model_est$conf.low, 3), nsmall = 3),
", ",
format(round(combined_ten_pd_model_est$conf.high, 3), nsmall = 3), ")", sep = "")
model_effect_estimates_to_be_combined <- rbind(model_effect_estimates_to_be_combined, combined_ten_pd_model_est)
ggplot() +
geom_point(combined_ten_pd_df_to_be_combined, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_to_be_combined, mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1, color = "Bootstrap Estimate")) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_to_be_combined,
mapping = aes(x = estimate, y = 16:1, color = "Model Estimate")) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_to_be_combined,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.8, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_to_be_combined,
mapping = aes(label = ci_95, x = 1.35, y = 16:1), size = 3) +
xlim(-.8, 1.7) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_to_be_combined$term[16:1])
ggplot() +
# geom_point(combined_ten_pd_df, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_to_be_combined, mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1)) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_to_be_combined,
mapping = aes(x = estimate, y = 16:1)) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_to_be_combined,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.8, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_to_be_combined,
mapping = aes(label = ci_95, x = 1.35, y = 16:1), size = 3) +
xlim(-.8, 1.7) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_to_be_combined$term[16:1])
#set up var-cov for attributable deaths
sd_for_attr_deaths <- merge(model_effect_estimates[,c("estimate", "term")],
combined_ten_pd_df[,c("term", "conf.low", "conf.high", "ci_95")],
by = "term")
rownames(sd_for_attr_deaths) <- sd_for_attr_deaths$term
bootstrap_attributable_deaths <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx,
sd_for_attr_deaths,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"))
bootstrap_attributable_deaths <- merge(bootstrap_attributable_deaths, date_data, by.x = "Time_Period", by.y = "Time_Period_ID")
bootstrap_attributable_deaths_summary <- bootstrap_attributable_deaths %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_lives_saved = sum(attr_deaths),
total_lives_saved_lb = sum(attr_deaths_lb),
total_lives_saved_ub = sum(attr_deaths_ub))
ggplot(bootstrap_attributable_deaths_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_lives_saved, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_lives_saved_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_lives_saved_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death,
Estimated Using Clustered Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
#plot with the observed od death
national_od_bs <- sensitivity_anlys_event_study_data_lin_post_tx %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_od = sum(imputed_deaths),
total_od_prob = sum(imputed_deaths)/sum(population),
total_pop = sum(population))
national_od_bs <- merge(national_od_bs, bootstrap_attributable_deaths_summary, by = "year")
ggplot(national_od_bs, aes(x = year)) +
geom_line(aes(y = total_lives_saved, linetype = "Estimate", color = "Lives Saved")) +
geom_line(aes(y = total_lives_saved_lb, linetype = "95% CI", color = "Lives Saved")) +
geom_line(aes(y = total_lives_saved_ub, linetype = "95% CI", color = "Lives Saved")) +
geom_line(aes(y = total_od, color = "Observed OD")) +
geom_line(aes(y = total_od + total_lives_saved, color = "Potential Number of Deaths Had There Not Been DIH Prosecutions")) +
labs(x = "Year", y = "Number of People",
title = "Number of Oberved OD, Estimated Number of Lives Saved,
and Potential Number of OD Had There Not Been DIH Prosecutions
in Each Year, CI Estimated by Clustered Bootstrap",
linetype = "", color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid")) +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))6.7.3.2 Unit Level
bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit <- boostrap_state_time_unit(sensitivity_anlys_event_study_data_lin_post_tx,
sensitivity_anlys_lin_post_tx_model_log_smoothed_time,
coef_of_interest = rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,]))
colnames(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit) <-
rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time[51:66,])
mean_coef_outcome_lin_post_tx_unit <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit, 2, mean)
ci_coef_outcome_lin_post_tx_unit <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit, 2, quantile, probs = c(.025, .975))
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit <- cbind(t(ci_coef_outcome_lin_post_tx_unit),
mean_coef_outcome_lin_post_tx_unit)
colnames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit <- data.frame(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit$ci_95 <- paste("95% CI = (",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit$conf.low,
3), nsmall = 3),
",",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit$conf.high,3), nsmall = 3),
")", sep = "")
# write.csv(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit ,
# "./Data/unit_bootstrap_smoothed_time_lin_tx_3_10_22.csv",
# row.names = FALSE)coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit <- read.csv("./Data/unit_bootstrap_smoothed_time_lin_tx_3_10_22.csv",
row.names = "term")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx)
dwplot(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit, colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient and 95% CI of Linear Post Tx Effects,
Smoothed Time Effects,
Using Unit Bootstrap") +
scale_color_grey() +
geom_text(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit,
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
bootstrap_attributable_deaths_unit <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx,
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"))
bootstrap_attributable_deaths_unit <- merge(bootstrap_attributable_deaths_unit, date_data, by.x = "Time_Period", by.y = "Time_Period_ID")
bootstrap_attributable_deaths_unit <- bootstrap_attributable_deaths_unit %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(lives_saved = sum(attr_deaths),
lives_saved_lb = sum(attr_deaths_lb),
lives_saved_ub = sum(attr_deaths_ub))
ggplot(bootstrap_attributable_deaths_unit, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = lives_saved, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = lives_saved_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = lives_saved_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved per Year
Using Model with Smoothed Time Effects,
Log Probability of Drug Overdose Death,
Estimated Using Unit Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))6.8 Analysis With Only Periods After Treatment Subset Periods
#run the gam model
data_subset <- sensitivity_anlys_event_study_data_lin_post_tx[sensitivity_anlys_event_study_data_lin_post_tx$Time_Period_ID <= 30,]
sensitivity_anlys_post_tx_model_log_smoothed_time_subset<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
Intervention_Redefined +
lag_num_pd_w_tx,
data = data_subset)
summary(sensitivity_anlys_post_tx_model_log_smoothed_time_subset)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + lag_num_pd_w_naloxone_yes +
## Naloxone_Pharmacy_No_Redefined + lag_num_pd_w_naloxone_no +
## Medical_Marijuana_Redefined + lag_num_pd_w_med_marijuana +
## Recreational_Marijuana_Redefined + lag_num_pd_w_rec_marijuana +
## GSL_Redefined + lag_num_pd_w_gsl + PDMP_Redefined + lag_num_pd_w_pdmp +
## Medicaid_Expansion_Redefined + lag_num_pd_w_medicaid + Intervention_Redefined +
## lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.951459 0.060807 -163.656 < 2e-16 ***
## StateAlaska 0.392796 0.095840 4.098 4.40e-05 ***
## StateArizona 0.392792 0.074735 5.256 1.70e-07 ***
## StateArkansas -0.440739 0.076208 -5.783 9.02e-09 ***
## StateCalifornia 0.172975 0.101297 1.708 0.087934 .
## StateColorado 0.223376 0.090539 2.467 0.013738 *
## StateConnecticut 0.441991 0.085610 5.163 2.78e-07 ***
## StateDelaware 0.157065 0.076923 2.042 0.041353 *
## StateFlorida 0.554720 0.078904 7.030 3.21e-12 ***
## StateGeorgia 0.296002 0.081281 3.642 0.000281 ***
## StateHawaii -0.311664 0.097704 -3.190 0.001455 **
## StateIdaho -0.236372 0.080656 -2.931 0.003438 **
## StateIllinois 0.339470 0.086098 3.943 8.45e-05 ***
## StateIndiana -0.108572 0.079585 -1.364 0.172716
## StateIowa -0.605676 0.073617 -8.227 4.33e-16 ***
## StateKansas -0.130961 0.073781 -1.775 0.076115 .
## StateKentucky 0.610785 0.079973 7.637 4.09e-14 ***
## StateLouisiana 0.448008 0.073978 6.056 1.79e-09 ***
## StateMaine 0.155585 0.094019 1.655 0.098186 .
## StateMaryland -1.638794 0.080100 -20.459 < 2e-16 ***
## StateMassachusetts -0.360711 0.080094 -4.504 7.24e-06 ***
## StateMichigan -0.042496 0.081743 -0.520 0.603232
## StateMinnesota -0.532398 0.081064 -6.568 7.19e-11 ***
## StateMississippi -0.013260 0.073783 -0.180 0.857398
## StateMissouri 0.304148 0.078774 3.861 0.000118 ***
## StateMontana -0.106784 0.083986 -1.271 0.203782
## StateNebraska -0.829029 0.076434 -10.846 < 2e-16 ***
## StateNevada 0.662710 0.093110 7.117 1.75e-12 ***
## StateNew Hampshire 0.107350 0.076936 1.395 0.163143
## StateNew Jersey 0.182514 0.077227 2.363 0.018247 *
## StateNew Mexico 1.077690 0.096046 11.221 < 2e-16 ***
## StateNew York -0.168394 0.083201 -2.024 0.043165 *
## StateNorth Carolina 0.295525 0.073589 4.016 6.24e-05 ***
## StateNorth Dakota -1.256486 0.073478 -17.100 < 2e-16 ***
## StateOhio 0.565952 0.078551 7.205 9.47e-13 ***
## StateOklahoma 0.431977 0.079705 5.420 7.02e-08 ***
## StateOregon 0.071640 0.095157 0.753 0.451658
## StatePennsylvania 0.604419 0.083834 7.210 9.15e-13 ***
## StateRhode Island -0.550541 0.085376 -6.448 1.55e-10 ***
## StateSouth Carolina 0.184131 0.073997 2.488 0.012949 *
## StateSouth Dakota -1.053738 0.076096 -13.848 < 2e-16 ***
## StateTennessee 0.418373 0.073630 5.682 1.62e-08 ***
## StateTexas 0.127799 0.083031 1.539 0.123988
## StateUtah -0.209871 0.079834 -2.629 0.008662 **
## StateVermont -0.097112 0.080309 -1.209 0.226777
## StateVirginia -0.028416 0.075970 -0.374 0.708434
## StateWashington 0.341978 0.093606 3.653 0.000268 ***
## StateWest Virginia 0.648490 0.080192 8.087 1.32e-15 ***
## StateWisconsin 0.090454 0.076056 1.189 0.234524
## StateWyoming -0.015496 0.073536 -0.211 0.833126
## Naloxone_Pharmacy_Yes_Redefined -0.178532 0.075409 -2.368 0.018043 *
## lag_num_pd_w_naloxone_yes -0.058586 0.023102 -2.536 0.011322 *
## Naloxone_Pharmacy_No_Redefined 0.150296 0.055069 2.729 0.006428 **
## lag_num_pd_w_naloxone_no -0.044257 0.005736 -7.716 2.28e-14 ***
## Medical_Marijuana_Redefined 0.234565 0.039668 5.913 4.21e-09 ***
## lag_num_pd_w_med_marijuana -0.016004 0.003107 -5.151 2.96e-07 ***
## Recreational_Marijuana_Redefined -0.249591 0.189149 -1.320 0.187202
## lag_num_pd_w_rec_marijuana 0.014694 0.090247 0.163 0.870683
## GSL_Redefined 0.134755 0.054771 2.460 0.014000 *
## lag_num_pd_w_gsl 0.009686 0.009938 0.975 0.329893
## PDMP_Redefined -0.123013 0.029478 -4.173 3.19e-05 ***
## lag_num_pd_w_pdmp 0.010963 0.002801 3.914 9.51e-05 ***
## Medicaid_Expansion_Redefined 0.033904 0.050582 0.670 0.502791
## lag_num_pd_w_medicaid 0.016100 0.014929 1.078 0.281019
## Intervention_Redefined -0.004995 0.027512 -0.182 0.855964
## lag_num_pd_w_tx -0.016953 0.002425 -6.990 4.26e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 2.641 3.301 121.06 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 7.646 8.531 37.71 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 2.966 3.697 84.05 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 2.863 3.578 49.98 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.832 Deviance explained = 84.1%
## GCV = 0.083767 Scale est. = 0.079119 n = 14806.8.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time_subset <-
data.frame(predict(sensitivity_anlys_post_tx_model_log_smoothed_time_subset, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_post_tx_log_smoothed_time_subset <- coef(sensitivity_anlys_post_tx_model_log_smoothed_time_subset)
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset_w_cov <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time_subset),
log(data_subset$prop_dead),
coefficient_values_sensitivity_anlys_post_tx_log_smoothed_time_subset,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_post_tx_log_smoothed_time_subset),
print_full_cov = TRUE)
# sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset <- sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset_w_cov[[1]]
colnames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset) <- c("conf.low", "estimate", "conf.high", "sd")
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term <- rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset)
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$ci_95 <-
paste("95% CI = (", format(round(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.low, 3), nsmall = 3), ", ",
format(round(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Linear Intervention, Subset Data") +
scale_color_grey() +
geom_text(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_log_all_yr_subset <- sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,]
table_of_RR_lin_eff_log_all_yr_subset$estimate <- round(exp(table_of_RR_lin_eff_log_all_yr_subset$estimate), 3)
table_of_RR_lin_eff_log_all_yr_subset$conf.low <- exp(table_of_RR_lin_eff_log_all_yr_subset$conf.low)
table_of_RR_lin_eff_log_all_yr_subset$conf.high <- exp(table_of_RR_lin_eff_log_all_yr_subset$conf.high)
table_of_RR_lin_eff_log_all_yr_subset$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_log_all_yr_subset$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_log_all_yr_subset$conf.high, 3), nsmall = 3), ")",
sep = "")
write.csv(table_of_RR_lin_eff_log_all_yr_subset, "./Data/table_of_RR_lin_eff_log_all_yr_subset_5_9_22.csv")6.8.2 Attributable Deaths
date_data_subset <- data_subset[, c("Time_Period_ID", "Time_Period_Start")]
date_data_subset <- date_data_subset[!duplicated(date_data_subset),]
var_cov_mat_beta_lin_tx_subset <- as.matrix(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset_w_cov[[2]][
c("Intervention_Redefined", "lag_num_pd_w_tx"), c("Intervention_Redefined", "lag_num_pd_w_tx")])
attr_deaths_est_log_smoothed_time_lin_post_subset <- attr_death_compute(data_subset,
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"),
var_cov_mat_beta_lin_tx_subset)
attr_deaths_est_log_smoothed_time_lin_post_subset <- merge(attr_deaths_est_log_smoothed_time_lin_post_subset, date_data_subset,
by.x = "Time_Period", by.y = "Time_Period_ID")
attr_deaths_est_log_smoothed_time_lin_post_subset_summary <- attr_deaths_est_log_smoothed_time_lin_post_subset %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_attr_deaths = sum(attr_deaths),
total_attr_deaths_lb = sum(attr_deaths_lb),
total_attr_deaths_ub = sum(attr_deaths_ub))
ggplot(attr_deaths_est_log_smoothed_time_lin_post_subset_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
ggplot() +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths, linetype = "Estimate",
color = "Full Dataset")) +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths_lb, linetype = "95% CI",
color = "Full Dataset")) +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths_ub, linetype = "95% CI",
color = "Full Dataset")) +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths, linetype = "Estimate",
color = "Subset Dataset")) +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths_lb,
linetype = "95% CI",
color = "Subset Dataset")) +
geom_line(attr_deaths_est_log_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths_ub,
linetype = "95% CI",
color = "Subset Dataset")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "", color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
6.8.3 Bootstrapping: Coefficient and Attributable Death Estimate
6.8.3.1 Clustered
bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset <- boostrap_state_time_group(data_subset,
sensitivity_anlys_post_tx_model_log_smoothed_time_subset,
coef_of_interest = rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,]),
nSim = 5000)
colnames(bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset) <-
rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,])
mean_coef_outcome_lin_post_tx_subset <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset, 2, mean)
ci_coef_outcome_lin_post_tx_subset <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset, 2, quantile, probs = c(.025, .975))
# write.csv(bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset,
# "./Data/all_clustered_bootstrap_smoothed_time_lin_tx_subset_3_11_22_nSim_5000.csv",
# row.names = FALSE)
ci_coef_outcome_lin_post_tx_subset <- cbind(t(ci_coef_outcome_lin_post_tx_subset),
mean_coef_outcome_lin_post_tx_subset)
colnames(ci_coef_outcome_lin_post_tx_subset) <- c("conf.low", "conf.high", "estimate")
ci_coef_outcome_lin_post_tx_subset <- data.frame(ci_coef_outcome_lin_post_tx_subset)
ci_coef_outcome_lin_post_tx_subset$term <- rownames(ci_coef_outcome_lin_post_tx_subset)
ci_coef_outcome_lin_post_tx_subset$ci_95 <- paste("95% CI = (",
format(round(ci_coef_outcome_lin_post_tx_subset$conf.low, 3), nsmall = 3),
",",
format(round(ci_coef_outcome_lin_post_tx_subset$conf.high,3), nsmall = 3),
")", sep = "")
# write.csv(ci_coef_outcome_lin_post_tx_subset,
# "./Data/clustered_bootstrap_smoothed_time_lin_tx_subset_3_11_22_nSim_5000.csv",
# row.names = FALSE)bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset <-
read.csv("./Data/all_clustered_bootstrap_smoothed_time_lin_tx_subset_3_11_22_nSim_5000.csv")
#first examine the distribution of coefficients
bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset_long <- bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset %>%
pivot_longer(cols = everything(),
names_to = "policy",
values_to = "coef_est")
ggplot(bootstrap_smoothed_eff_log_outcome_lin_post_tx_subset_long, aes(y = coef_est, x = policy)) +
geom_boxplot() +
labs(x = "Policies", y = "Coefficient Estimates",
title = "Clustered Bootstrap Distribution of Coefficient Estimates",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(size = 5, angle = 45))
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset <-
read.csv("./Data/clustered_bootstrap_smoothed_time_lin_tx_subset_3_11_22_nSim_5000.csv",
row.names = "term")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset)
#multiply coefficients by 10 if they're the linear effects
ten_pd_eff_subset <- coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset[
rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
ten_pd_eff_subset$estimate <- ten_pd_eff_subset$estimate*10
ten_pd_eff_subset$conf.high <- ten_pd_eff_subset$conf.high*10
ten_pd_eff_subset$conf.low <- ten_pd_eff_subset$conf.low*10
ten_pd_eff_subset$ci_95 <- paste("95% CI = (", format(round(ten_pd_eff_subset$conf.low, 3), nsmall = 3), ", ",
format(round(ten_pd_eff_subset$conf.high, 3), nsmall = 3), ")", sep = "")
rownames(ten_pd_eff_subset) <- ten_pd_eff_subset$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_df_subset <- rbind(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_subset, ten_pd_eff_subset)
combined_ten_pd_df_subset_to_combine <- combined_ten_pd_df_subset %>%
filter(!(term %in% c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx")))
#put model estimates in the plot
model_effect_estimates_subset <- sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,]
model_effect_estimates_subset_to_combine <- model_effect_estimates_subset[
!rownames(model_effect_estimates_subset) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
combined_ten_pd_model_est_subset <- sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[
rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
rownames(combined_ten_pd_model_est_subset) <- combined_ten_pd_model_est_subset$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_model_est_subset$estimate <- combined_ten_pd_model_est_subset$estimate*10
combined_ten_pd_model_est_subset$conf.low <- combined_ten_pd_model_est_subset$conf.low*10
combined_ten_pd_model_est_subset$conf.high <- combined_ten_pd_model_est_subset$conf.high*10
combined_ten_pd_model_est_subset$ci_95 <- paste("95% CI = (",
format(round(combined_ten_pd_model_est_subset$conf.low, 3), nsmall = 3),
", ",
format(round(combined_ten_pd_model_est_subset$conf.high, 3), nsmall = 3), ")", sep = "")
model_effect_estimates_subset_to_combine <- rbind(model_effect_estimates_subset_to_combine, combined_ten_pd_model_est_subset)
ggplot() +
geom_point(combined_ten_pd_df_subset_to_combine, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_subset_to_combine,
mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1, color = "Bootstrap Estimate")) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_subset_to_combine,
mapping = aes(x = estimate, y = 16:1, color = "Model Estimate")) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_subset_to_combine,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 1.5, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_subset_to_combine,
mapping = aes(label = ci_95, x = 2.6, y = 16:1), size = 3) +
xlim(-2, 3.3) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_subset_to_combine$term[16:1])
ggplot() +
# geom_point(combined_ten_pd_df_subset, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_subset_to_combine, mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1)) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_subset_to_combine,
mapping = aes(x = estimate, y = 16:1)) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap for Subset Data",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_subset_to_combine,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 1.5, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_subset_to_combine,
mapping = aes(label = ci_95, x = 2.6, y = 16:1), size = 3) +
xlim(-2, 3.3) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_subset_to_combine$term[16:1])
ggplot() +
# geom_point(combined_ten_pd_df_subset, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_subset_to_combine,
mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1, color = "Subset Data"),
alpha = 0.5) +
geom_linerange(model_effect_estimates_to_be_combined,
mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1, color = "Full Data"), alpha = 0.5) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_subset_to_combine,
mapping = aes(x = estimate, y = 16:1, color = "Subset Data")) +
geom_point(model_effect_estimates_to_be_combined,
mapping = aes(x = estimate, y = 16:1, color = "Full Data")) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap for Full and Subset Data",
color = "Estimate Type") +
# scale_color_grey() +
# geom_text(model_effect_estimates_subset,
# mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 1.5, y = 16:1), size = 3) +
# geom_text(combined_ten_pd_df_subset,
# mapping = aes(label = ci_95, x = 2.6, y = 16:1), size = 3) +
# xlim(-2, 3.2) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_subset_to_combine$term[16:1])
sd_for_attr_death_subset <- merge(model_effect_estimates_subset[,c("term", "estimate")],
combined_ten_pd_df_subset[,c("conf.low", "term", "conf.high", "ci_95")],
by = "term")
rownames(sd_for_attr_death_subset) <- sd_for_attr_death_subset$term
bootstrap_attributable_deaths_subset <- attr_death_compute(data_subset,
sd_for_attr_death_subset,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"))
bootstrap_attributable_deaths_subset <- merge(bootstrap_attributable_deaths_subset, date_data_subset,
by.x = "Time_Period", by.y = "Time_Period_ID")
bootstrap_attributable_deaths_subset <- bootstrap_attributable_deaths_subset %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(lives_saved = sum(attr_deaths),
lives_saved_lb = sum(attr_deaths_lb),
lives_saved_ub = sum(attr_deaths_ub))
ggplot(bootstrap_attributable_deaths_subset, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = lives_saved, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = lives_saved_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = lives_saved_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Model with Smoothed Time Effects,
Log Probability of Drug Overdose Death,
Estimated Using Clustered Bootstrap on Subset Data",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
ggplot() +
geom_line(bootstrap_attributable_deaths_subset,
mapping = aes(x = year, y = lives_saved, linetype = "Estimate", color = "Subset Data")) +
geom_line(bootstrap_attributable_deaths_subset,
mapping = aes(x = year, y = lives_saved_lb, linetype = "95% CI", color = "Subset Data")) +
geom_line(bootstrap_attributable_deaths_subset,
mapping = aes(x = year, y = lives_saved_ub, linetype = "95% CI", color = "Subset Data")) +
geom_line(bootstrap_attributable_deaths_summary[bootstrap_attributable_deaths_summary$year <= 2014, ],
mapping = aes(x = year, y = total_lives_saved, linetype = "Estimate", color = "Full Data")) +
geom_line(bootstrap_attributable_deaths_summary[bootstrap_attributable_deaths_summary$year <= 2014, ],
mapping = aes(x = year, y = total_lives_saved_lb, linetype = "95% CI", color = "Full Data")) +
geom_line(bootstrap_attributable_deaths_summary[bootstrap_attributable_deaths_summary$year <= 2014, ],
mapping = aes(x = year, y = total_lives_saved_ub, linetype = "95% CI", color = "Full Data")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Model with Smoothed Time Effects
and Linear Policy Effects,
Estimated Using Clustered Bootstrap
for Subset Data and Full Data until 2015",
linetype = "", color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))6.8.3.2 Unit Level
bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset <- boostrap_state_time_unit(data_subset,
sensitivity_anlys_post_tx_model_log_smoothed_time_subset,
coef_of_interest = rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,]))
colnames(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset) <-
rownames(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset[51:66,])
mean_coef_outcome_lin_post_tx_unit_subset <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset, 2, mean)
ci_coef_outcome_lin_post_tx_unit_subset <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset, 2,
quantile, probs = c(.025, .975))
summary_coef_outcome_lin_post_tx_unit_subset <- apply(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset, 2,
summary)
# write.csv(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset ,
# "./Data/all_unit_bootstrap_smoothed_time_lin_tx_subset_3_10_22.csv",
# row.names = FALSE)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset <- cbind(t(ci_coef_outcome_lin_post_tx_unit_subset),
mean_coef_outcome_lin_post_tx_unit_subset)
colnames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset <- data.frame(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset)
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset$ci_95 <- paste("95% CI = (",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset$conf.low,
3), nsmall = 3),
",",
format(round(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset$conf.high,3), nsmall = 3),
")", sep = "")
# write.csv(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset ,
# "./Data/unit_bootstrap_smoothed_time_lin_tx_subset_3_10_22.csv",
# row.names = FALSE)bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset <- read.csv("./Data/all_unit_bootstrap_smoothed_time_lin_tx_subset_3_10_22.csv")
#first examine the disribution of coefficients
bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset_long <- bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset %>%
pivot_longer(cols = everything(),
names_to = "policy",
values_to = "coef_est")
ggplot(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset_long, aes(y = coef_est, x = policy)) +
geom_boxplot() +
labs(x = "Policies", y = "Coefficient Estimates",
title = "Bootstrap Distribution of Coefficient Estimates",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(size = 5, angle = 45))
ggplot(bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset_long[
!bootstrap_smoothed_eff_log_outcome_lin_post_tx_unit_subset_long$policy %in%
c("Recreational_Marijuana_Redefined", "lag_num_pd_w_rec_marijuana"),], aes(y = coef_est, x = policy)) +
geom_boxplot() +
labs(x = "Policies", y = "Coefficient Estimates",
title = "Bootstrap Distribution of Coefficient Estimates Without Recreational Marijuana Policies",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
axis.text.x = element_text(size = 5, angle = 45))
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset <- read.csv("./Data/unit_bootstrap_smoothed_time_lin_tx_subset_3_10_22.csv",
row.names = "term")
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset$term <- rownames(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset)
dwplot(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset, colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient and 95% CI of Linear Post Tx Effects,
Smoothed Time Effects,
Using Unit Bootstrap, Subset Data") +
scale_color_grey() +
geom_text(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset,
mapping = aes(label = ci_95, x = 1, y = 16:1), size = 3) +
xlim(-.65, 1.2)
bootstrap_attributable_deaths_unit_subset <- attr_death_compute(data_subset,
coef_w_ci_smoothed_time_log_outcome_lin_post_tx_unit_subset,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"))
bootstrap_attributable_deaths_unit_subset <- merge(bootstrap_attributable_deaths_unit_subset, date_data_subset,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(bootstrap_attributable_deaths_unit_subset, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death,
Estimated Using Unit Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))6.9 Analysis With Linear Effects Periods After Treatment Logistic Regression
#run the gam model
sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time<-gam(cbind(round(imputed_deaths), round(num_alive))~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
Intervention_Redefined +
lag_num_pd_w_tx,
data = sensitivity_anlys_event_study_data_lin_post_tx,
family = "binomial")
summary(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time)##
## Family: binomial
## Link function: logit
##
## Formula:
## cbind(round(imputed_deaths), round(num_alive)) ~ State + s(Time_Period_ID,
## bs = "cr", by = as.factor(Region)) + Naloxone_Pharmacy_Yes_Redefined +
## lag_num_pd_w_naloxone_yes + Naloxone_Pharmacy_No_Redefined +
## lag_num_pd_w_naloxone_no + Medical_Marijuana_Redefined +
## lag_num_pd_w_med_marijuana + Recreational_Marijuana_Redefined +
## lag_num_pd_w_rec_marijuana + GSL_Redefined + lag_num_pd_w_gsl +
## PDMP_Redefined + lag_num_pd_w_pdmp + Medicaid_Expansion_Redefined +
## lag_num_pd_w_medicaid + Intervention_Redefined + lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.6918398 0.0165286 -586.368 < 2e-16 ***
## StateAlaska 0.1660062 0.0316907 5.238 1.62e-07 ***
## StateArizona 0.2470040 0.0148999 16.578 < 2e-16 ***
## StateArkansas -0.4514581 0.0211955 -21.300 < 2e-16 ***
## StateCalifornia 0.0115038 0.0191547 0.601 0.548126
## StateColorado 0.1212188 0.0196259 6.176 6.56e-10 ***
## StateConnecticut 0.0859484 0.0173084 4.966 6.85e-07 ***
## StateDelaware 0.2921966 0.0245539 11.900 < 2e-16 ***
## StateFlorida 0.4469502 0.0148057 30.188 < 2e-16 ***
## StateGeorgia 0.2005269 0.0169730 11.814 < 2e-16 ***
## StateHawaii -0.3867800 0.0302216 -12.798 < 2e-16 ***
## StateIdaho -0.3168152 0.0254657 -12.441 < 2e-16 ***
## StateIllinois 0.1658041 0.0165498 10.018 < 2e-16 ***
## StateIndiana -0.0491962 0.0157645 -3.121 0.001804 **
## StateIowa -0.6671034 0.0219000 -30.461 < 2e-16 ***
## StateKansas -0.3062736 0.0197456 -15.511 < 2e-16 ***
## StateKentucky 0.5188091 0.0154340 33.615 < 2e-16 ***
## StateLouisiana 0.4010566 0.0149643 26.801 < 2e-16 ***
## StateMaine 0.2586864 0.0263564 9.815 < 2e-16 ***
## StateMaryland -0.9568958 0.0217895 -43.915 < 2e-16 ***
## StateMassachusetts 0.1586346 0.0151818 10.449 < 2e-16 ***
## StateMichigan 0.0130877 0.0162585 0.805 0.420834
## StateMinnesota -0.5908795 0.0197106 -29.978 < 2e-16 ***
## StateMississippi -0.2354073 0.0188147 -12.512 < 2e-16 ***
## StateMissouri 0.3211547 0.0188890 17.002 < 2e-16 ***
## StateMontana -0.1494454 0.0313434 -4.768 1.86e-06 ***
## StateNebraska -0.9918381 0.0296070 -33.500 < 2e-16 ***
## StateNevada 0.5342117 0.0205026 26.056 < 2e-16 ***
## StateNew Hampshire 0.2682052 0.0215241 12.461 < 2e-16 ***
## StateNew Jersey 0.2753953 0.0154320 17.846 < 2e-16 ***
## StateNew Mexico 0.5017865 0.0195363 25.685 < 2e-16 ***
## StateNew York -0.3234978 0.0143800 -22.496 < 2e-16 ***
## StateNorth Carolina 0.2718936 0.0132117 20.580 < 2e-16 ***
## StateNorth Dakota -1.1953770 0.0457733 -26.115 < 2e-16 ***
## StateOhio 0.6679880 0.0152538 43.792 < 2e-16 ***
## StateOklahoma 0.2955589 0.0165172 17.894 < 2e-16 ***
## StateOregon -0.0682414 0.0223395 -3.055 0.002253 **
## StatePennsylvania 0.5992187 0.0159711 37.519 < 2e-16 ***
## StateRhode Island 0.1401910 0.0245331 5.714 1.10e-08 ***
## StateSouth Carolina 0.0672272 0.0160186 4.197 2.71e-05 ***
## StateSouth Dakota -1.1228077 0.0435739 -25.768 < 2e-16 ***
## StateTennessee 0.4346807 0.0133160 32.643 < 2e-16 ***
## StateTexas -0.0454967 0.0159415 -2.854 0.004317 **
## StateUtah 0.0780823 0.0196717 3.969 7.21e-05 ***
## StateVermont -0.1154520 0.0325629 -3.546 0.000392 ***
## StateVirginia -0.0106755 0.0150892 -0.707 0.479259
## StateWashington 0.1034138 0.0192418 5.374 7.68e-08 ***
## StateWest Virginia 0.6933803 0.0173454 39.975 < 2e-16 ***
## StateWisconsin 0.0702017 0.0158598 4.426 9.58e-06 ***
## StateWyoming -0.0314449 0.0337961 -0.930 0.352148
## Naloxone_Pharmacy_Yes_Redefined 0.0155747 0.0080655 1.931 0.053480 .
## lag_num_pd_w_naloxone_yes -0.0213838 0.0011158 -19.165 < 2e-16 ***
## Naloxone_Pharmacy_No_Redefined 0.0619851 0.0079301 7.816 5.43e-15 ***
## lag_num_pd_w_naloxone_no -0.0021388 0.0009269 -2.307 0.021031 *
## Medical_Marijuana_Redefined 0.0335407 0.0058322 5.751 8.87e-09 ***
## lag_num_pd_w_med_marijuana -0.0038222 0.0006421 -5.953 2.64e-09 ***
## Recreational_Marijuana_Redefined 0.0018514 0.0101063 0.183 0.854649
## lag_num_pd_w_rec_marijuana -0.0199844 0.0019355 -10.325 < 2e-16 ***
## GSL_Redefined 0.0256909 0.0060998 4.212 2.53e-05 ***
## lag_num_pd_w_gsl 0.0135896 0.0008501 15.987 < 2e-16 ***
## PDMP_Redefined -0.0327741 0.0068817 -4.762 1.91e-06 ***
## lag_num_pd_w_pdmp 0.0046873 0.0006373 7.355 1.91e-13 ***
## Medicaid_Expansion_Redefined 0.0676747 0.0067899 9.967 < 2e-16 ***
## lag_num_pd_w_medicaid 0.0142307 0.0010244 13.892 < 2e-16 ***
## Intervention_Redefined -0.0187494 0.0063105 -2.971 0.002967 **
## lag_num_pd_w_tx -0.0148682 0.0005601 -26.544 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(Time_Period_ID):as.factor(Region)Midwest 8.923 8.998 4729 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.964 9.000 4285 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 8.937 8.999 4379 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 8.775 8.984 2117 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.917 Deviance explained = 91.2%
## UBRE = 7.8233 Scale est. = 1 n = 1980plot(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time, pages = 1)
6.9.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_logistic_smoothed_time <-
data.frame(predict(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_lin_post_tx_logistic_smoothed_time <- coef(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time)
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time_w_cov <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_logistic_smoothed_time),
log(sensitivity_anlys_event_study_data$prop_dead),
coefficient_values_sensitivity_anlys_lin_post_tx_logistic_smoothed_time,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_lin_post_tx_logistic_smoothed_time),
print_full_cov = TRUE)
# format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time, 3), nsmall = 3)
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time <- sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time_w_cov[[1]]
colnames(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time) <- c("conf.low", "estimate", "conf.high", "sd")
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term <- rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time)
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$ci_95 <-
paste("95% CI = (", format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.low, 3), nsmall = 3), ", ",
format(round(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Linear Intervention") +
scale_color_grey() +
geom_text(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_logistic_all_yr <- sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,]
table_of_RR_lin_eff_logistic_all_yr$estimate <- round(exp(table_of_RR_lin_eff_logistic_all_yr$estimate), 3)
table_of_RR_lin_eff_logistic_all_yr$conf.low <- exp(table_of_RR_lin_eff_logistic_all_yr$conf.low)
table_of_RR_lin_eff_logistic_all_yr$conf.high <- exp(table_of_RR_lin_eff_logistic_all_yr$conf.high)
table_of_RR_lin_eff_logistic_all_yr$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_logistic_all_yr$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_logistic_all_yr$conf.high, 3), nsmall = 3), ")",
sep = "")
write.csv(table_of_RR_lin_eff_logistic_all_yr, "./Data/table_of_RR_lin_eff_logistic_all_yr_5_9_22.csv")6.9.2 Attributable Deaths
date_data <- sensitivity_anlys_event_study_data_lin_post_tx[, c("Time_Period_ID", "Time_Period_Start")]
date_data <- date_data[!duplicated(date_data),]
var_cov_mat_beta_logistic_tx <- as.matrix(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time_w_cov[[2]][
c("Intervention_Redefined", "lag_num_pd_w_tx"), c("Intervention_Redefined", "lag_num_pd_w_tx")])
attr_deaths_est_logistic_smoothed_time_lin_post <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx,
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time,
lin_model = TRUE,
tx_name = c("Intervention_Redefined",
"lag_num_pd_w_tx"),
var_cov_mat_beta_logistic_tx)
attr_deaths_est_logistic_smoothed_time_lin_post <- merge(attr_deaths_est_logistic_smoothed_time_lin_post, date_data,
by.x = "Time_Period", by.y = "Time_Period_ID")
attr_deaths_est_logistic_smoothed_time_lin_post_summary <- attr_deaths_est_logistic_smoothed_time_lin_post %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_attr_deaths = sum(attr_deaths),
total_attr_deaths_lb = sum(attr_deaths_lb),
total_attr_deaths_ub = sum(attr_deaths_ub))
ggplot(attr_deaths_est_logistic_smoothed_time_lin_post_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year,
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
#overall national overdose deaths
national_od <- sensitivity_anlys_event_study_data_lin_post_tx %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_od = sum(imputed_deaths),
total_od_prob = sum(imputed_deaths)/sum(population),
total_pop = sum(population))
national_od <- merge(national_od, attr_deaths_est_logistic_smoothed_time_lin_post_summary, by = "year")
ggplot(national_od, aes(x = year)) +
geom_line(aes(y = total_od, color = "Oberved OD")) +
geom_line(aes(y = total_attr_deaths, color = "Lives Saved", linetype = "Estimate")) +
geom_line(aes(y = total_attr_deaths_lb, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths_ub, color = "Lives Saved", linetype = "95% CI")) +
geom_line(aes(y = total_attr_deaths + total_od,
color = "Potential Number of Deaths Had There Not Been DIH Prosecutions")) +
labs(x = "Date", y = "People",
title = "Number of OD Deaths and Estimated Number of Lives Saved in Each Year",
color = "", linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid")) +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
6.9.3 Bootstrapping: Coefficient and Attributable Death Estimate
6.9.3.1 Clustered
bootstrap_smoothed_eff_logistic_outcome_lin_post_tx <- boostrap_state_time_group(sensitivity_anlys_event_study_data_lin_post_tx,
sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time,
coef_of_interest = rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,]),
nSim = 5000)
colnames(bootstrap_smoothed_eff_logistic_outcome_lin_post_tx) <- rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,])
# write.csv(bootstrap_smoothed_eff_logistic_outcome_lin_post_tx,
# "./Data/all_clustered_bootstrap_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
# row.names = FALSE)
mean_coef_outcome_lin_post_tx <- apply(bootstrap_smoothed_eff_logistic_outcome_lin_post_tx, 2, mean)
ci_coef_outcome_lin_post_tx <- apply(bootstrap_smoothed_eff_logistic_outcome_lin_post_tx, 2, quantile, probs = c(.025, .975))
coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx <- cbind(t(ci_coef_outcome_lin_post_tx),
mean_coef_outcome_lin_post_tx)
colnames(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx) <- c("conf.low", "conf.high", "estimate")
coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx <- data.frame(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx)
coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx$term <- rownames(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx)
coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx$ci_95 <- paste("95% CI = (",
format(round(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx$conf.low, 3),
nsmall = 3),
",",
format(round(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx$conf.high,3),
nsmall = 3),
")", sep = "")
# write.csv(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx,
# "./Data/clustered_bootstrap_summary_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
# row.names = FALSE)coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx <-
read.csv("./Data/clustered_bootstrap_summary_smoothed_time_lin_tx_3_11_22_nSim_5000.csv",
row.names = "term")
coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx$term <- rownames(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx)
#multiply coefficients by 10 if they're the linear effects
ten_pd_eff <- coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx[rownames(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
ten_pd_eff$estimate <- ten_pd_eff$estimate*10
ten_pd_eff$conf.high <- ten_pd_eff$conf.high*10
ten_pd_eff$conf.low <- ten_pd_eff$conf.low*10
ten_pd_eff$ci_95 <- paste("95% CI = (", format(round(ten_pd_eff$conf.low, 3), nsmall = 3), ", ", format(round(ten_pd_eff$conf.high, 3),
nsmall = 3), ")", sep = "")
rownames(ten_pd_eff) <- ten_pd_eff$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_df <- rbind(coef_w_ci_smoothed_time_logistic_outcome_lin_post_tx, ten_pd_eff)
combined_ten_pd_df_to_be_combined <- combined_ten_pd_df %>%
filter(!(term %in% c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx")))
#put model estimates in the plot
model_effect_estimates <- sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[51:66,]
model_effect_estimates_to_be_combined <- model_effect_estimates[
!rownames(model_effect_estimates) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
combined_ten_pd_model_est <- sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time[
rownames(sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time) %in%
c("lag_num_pd_w_naloxone_yes",
"lag_num_pd_w_naloxone_no",
"lag_num_pd_w_med_marijuana",
"lag_num_pd_w_rec_marijuana",
"lag_num_pd_w_gsl",
"lag_num_pd_w_pdmp",
"lag_num_pd_w_medicaid",
"lag_num_pd_w_tx"),]
rownames(combined_ten_pd_model_est) <- combined_ten_pd_model_est$term <- c("num_pd_w_naloxone_yes_per_5_yr",
"num_pd_w_naloxone_no_per_5_yr",
"num_pd_w_med_marijuana_per_5_yr",
"num_pd_w_rec_marijuana_per_5_yr",
"num_pd_w_gsl_per_5_yr",
"num_pd_w_pdmp_per_5_yr",
"num_pd_w_medicaid_per_5_yr",
"num_pd_w_tx_per_5_yr")
combined_ten_pd_model_est$estimate <- combined_ten_pd_model_est$estimate*10
combined_ten_pd_model_est$conf.low <- combined_ten_pd_model_est$conf.low*10
combined_ten_pd_model_est$conf.high <- combined_ten_pd_model_est$conf.high*10
combined_ten_pd_model_est$ci_95 <- paste("95% CI = (",
format(round(combined_ten_pd_model_est$conf.low, 3), nsmall = 3),
", ",
format(round(combined_ten_pd_model_est$conf.high, 3), nsmall = 3), ")", sep = "")
model_effect_estimates_to_be_combined <- rbind(model_effect_estimates_to_be_combined, combined_ten_pd_model_est)
ggplot() +
geom_point(combined_ten_pd_df_to_be_combined, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_to_be_combined, mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1, color = "Bootstrap Estimate")) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_to_be_combined,
mapping = aes(x = estimate, y = 16:1, color = "Model Estimate")) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_to_be_combined,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.8, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_to_be_combined,
mapping = aes(label = ci_95, x = 1.35, y = 16:1), size = 3) +
xlim(-.8, 1.7) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_to_be_combined$term[16:1])
ggplot() +
# geom_point(combined_ten_pd_df, mapping = aes(x = estimate, y = 16:1, color = "Bootstrap Estimate")) +
geom_linerange(combined_ten_pd_df_to_be_combined, mapping = aes(xmin = conf.low, xmax = conf.high, y = 16:1)) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(color = "black"),
legend.position = "bottom") +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
geom_point(model_effect_estimates_to_be_combined,
mapping = aes(x = estimate, y = 16:1)) +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Model Coefficient and Bootstrap 95% CI of
Model Using Smoothed Time Effects,
Linear Policy Effects,
Using Clustered Bootstrap",
color = "Estimate Type") +
# scale_color_grey() +
geom_text(model_effect_estimates_to_be_combined,
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.8, y = 16:1), size = 3) +
geom_text(combined_ten_pd_df_to_be_combined,
mapping = aes(label = ci_95, x = 1.35, y = 16:1), size = 3) +
xlim(-.8, 1.7) +
scale_y_continuous(breaks = 1:16, labels = combined_ten_pd_df_to_be_combined$term[16:1])
#set up var-cov for attributable deaths
sd_for_attr_deaths <- merge(model_effect_estimates[,c("estimate", "term")],
combined_ten_pd_df[,c("term", "conf.low", "conf.high", "ci_95")],
by = "term")
rownames(sd_for_attr_deaths) <- sd_for_attr_deaths$term
bootstrap_attributable_deaths <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx,
sd_for_attr_deaths,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"))
bootstrap_attributable_deaths <- merge(bootstrap_attributable_deaths, date_data, by.x = "Time_Period", by.y = "Time_Period_ID")
bootstrap_attributable_deaths_summary <- bootstrap_attributable_deaths %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_lives_saved = sum(attr_deaths),
total_lives_saved_lb = sum(attr_deaths_lb),
total_lives_saved_ub = sum(attr_deaths_ub))
ggplot(bootstrap_attributable_deaths_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_lives_saved, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_lives_saved_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_lives_saved_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death,
Estimated Using Clustered Bootstrap",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
#plot with the observed od death
national_od_bs <- sensitivity_anlys_event_study_data_lin_post_tx %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_od = sum(imputed_deaths),
total_od_prob = sum(imputed_deaths)/sum(population),
total_pop = sum(population))
national_od_bs <- merge(national_od_bs, bootstrap_attributable_deaths_summary, by = "year")
ggplot(national_od_bs, aes(x = year)) +
geom_line(aes(y = total_lives_saved, linetype = "Estimate", color = "Lives Saved")) +
geom_line(aes(y = total_lives_saved_lb, linetype = "95% CI", color = "Lives Saved")) +
geom_line(aes(y = total_lives_saved_ub, linetype = "95% CI", color = "Lives Saved")) +
geom_line(aes(y = total_od, color = "Observed OD")) +
geom_line(aes(y = total_od + total_lives_saved, color = "Potential Number of Deaths Had There Not Been DIH Prosecutions")) +
labs(x = "Year", y = "Number of People",
title = "Number of Oberved OD, Estimated Number of Lives Saved,
and Potential Number of OD Had There Not Been DIH Prosecutions
in Each Year, CI Estimated by Clustered Bootstrap",
linetype = "", color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid")) +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))6.10 Analysis With Only Periods After Treatment Subset Periods
#run the gam model
data_subset <- sensitivity_anlys_event_study_data_lin_post_tx[sensitivity_anlys_event_study_data_lin_post_tx$Time_Period_ID <= 30,]
sensitivity_anlys_post_tx_model_logistic_smoothed_time_subset<-gam(cbind(round(imputed_deaths), round(num_alive))~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
Intervention_Redefined +
lag_num_pd_w_tx,
data = data_subset,
family = "binomial")
summary(sensitivity_anlys_post_tx_model_logistic_smoothed_time_subset)##
## Family: binomial
## Link function: logit
##
## Formula:
## cbind(round(imputed_deaths), round(num_alive)) ~ State + s(Time_Period_ID,
## bs = "cr", by = as.factor(Region)) + Naloxone_Pharmacy_Yes_Redefined +
## lag_num_pd_w_naloxone_yes + Naloxone_Pharmacy_No_Redefined +
## lag_num_pd_w_naloxone_no + Medical_Marijuana_Redefined +
## lag_num_pd_w_med_marijuana + Recreational_Marijuana_Redefined +
## lag_num_pd_w_rec_marijuana + GSL_Redefined + lag_num_pd_w_gsl +
## PDMP_Redefined + lag_num_pd_w_pdmp + Medicaid_Expansion_Redefined +
## lag_num_pd_w_medicaid + Intervention_Redefined + lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.9142839 0.0169704 -584.212 < 2e-16 ***
## StateAlaska 0.4656840 0.0395133 11.786 < 2e-16 ***
## StateArizona 0.3260481 0.0181969 17.918 < 2e-16 ***
## StateArkansas -0.3816820 0.0264243 -14.444 < 2e-16 ***
## StateCalifornia 0.1374486 0.0253367 5.425 5.80e-08 ***
## StateColorado 0.2421707 0.0256020 9.459 < 2e-16 ***
## StateConnecticut 0.2023745 0.0227399 8.900 < 2e-16 ***
## StateDelaware 0.1746091 0.0329617 5.297 1.18e-07 ***
## StateFlorida 0.5171831 0.0179741 28.774 < 2e-16 ***
## StateGeorgia 0.2669132 0.0206240 12.942 < 2e-16 ***
## StateHawaii -0.3190920 0.0385663 -8.274 < 2e-16 ***
## StateIdaho -0.3220520 0.0325556 -9.892 < 2e-16 ***
## StateIllinois 0.2045205 0.0202426 10.103 < 2e-16 ***
## StateIndiana -0.1287957 0.0204247 -6.306 2.87e-10 ***
## StateIowa -0.6289116 0.0277864 -22.634 < 2e-16 ***
## StateKansas -0.2274021 0.0245331 -9.269 < 2e-16 ***
## StateKentucky 0.5383433 0.0196523 27.393 < 2e-16 ***
## StateLouisiana 0.4179674 0.0188506 22.173 < 2e-16 ***
## StateMaine 0.1200546 0.0349900 3.431 0.000601 ***
## StateMaryland -1.3997811 0.0323084 -43.326 < 2e-16 ***
## StateMassachusetts -0.0196295 0.0199764 -0.983 0.325788
## StateMichigan -0.0430901 0.0201842 -2.135 0.032774 *
## StateMinnesota -0.5445597 0.0251231 -21.676 < 2e-16 ***
## StateMississippi -0.0899853 0.0230006 -3.912 9.14e-05 ***
## StateMissouri 0.2681887 0.0207599 12.919 < 2e-16 ***
## StateMontana -0.0404765 0.0382705 -1.058 0.290219
## StateNebraska -0.8858219 0.0371221 -23.862 < 2e-16 ***
## StateNevada 0.6634038 0.0263718 25.156 < 2e-16 ***
## StateNew Hampshire 0.1264438 0.0289908 4.362 1.29e-05 ***
## StateNew Jersey 0.1877752 0.0190435 9.860 < 2e-16 ***
## StateNew Mexico 0.8956733 0.0258327 34.672 < 2e-16 ***
## StateNew York -0.2818616 0.0188755 -14.933 < 2e-16 ***
## StateNorth Carolina 0.2273335 0.0168711 13.475 < 2e-16 ***
## StateNorth Dakota -1.3175979 0.0667482 -19.740 < 2e-16 ***
## StateOhio 0.5456305 0.0183878 29.674 < 2e-16 ***
## StateOklahoma 0.3790127 0.0205461 18.447 < 2e-16 ***
## StateOregon 0.0479041 0.0289839 1.653 0.098375 .
## StatePennsylvania 0.5443358 0.0198662 27.400 < 2e-16 ***
## StateRhode Island 0.0880039 0.0325676 2.702 0.006888 **
## StateSouth Carolina 0.1159933 0.0196563 5.901 3.61e-09 ***
## StateSouth Dakota -1.0671710 0.0567210 -18.814 < 2e-16 ***
## StateTennessee 0.3589872 0.0172473 20.814 < 2e-16 ***
## StateTexas 0.0417948 0.0194628 2.147 0.031760 *
## StateUtah -0.0404964 0.0260012 -1.557 0.119356
## StateVermont -0.1079730 0.0434154 -2.487 0.012884 *
## StateVirginia -0.1214341 0.0194204 -6.253 4.03e-10 ***
## StateWashington 0.3361612 0.0252409 13.318 < 2e-16 ***
## StateWest Virginia 0.6700384 0.0222475 30.117 < 2e-16 ***
## StateWisconsin 0.0452589 0.0202226 2.238 0.025219 *
## StateWyoming 0.0198349 0.0416322 0.476 0.633768
## Naloxone_Pharmacy_Yes_Redefined -0.0451257 0.0135442 -3.332 0.000863 ***
## lag_num_pd_w_naloxone_yes -0.0348725 0.0036484 -9.558 < 2e-16 ***
## Naloxone_Pharmacy_No_Redefined 0.1033996 0.0105883 9.765 < 2e-16 ***
## lag_num_pd_w_naloxone_no -0.0142420 0.0012446 -11.443 < 2e-16 ***
## Medical_Marijuana_Redefined 0.0208996 0.0101291 2.063 0.039081 *
## lag_num_pd_w_med_marijuana -0.0050364 0.0010727 -4.695 2.66e-06 ***
## Recreational_Marijuana_Redefined -0.1575028 0.0385241 -4.088 4.34e-05 ***
## lag_num_pd_w_rec_marijuana -0.0170023 0.0185896 -0.915 0.360394
## GSL_Redefined -0.0262166 0.0102647 -2.554 0.010648 *
## lag_num_pd_w_gsl 0.0005865 0.0025692 0.228 0.819417
## PDMP_Redefined -0.0457857 0.0078718 -5.816 6.01e-09 ***
## lag_num_pd_w_pdmp 0.0074035 0.0008069 9.175 < 2e-16 ***
## Medicaid_Expansion_Redefined 0.0467635 0.0104219 4.487 7.22e-06 ***
## lag_num_pd_w_medicaid 0.0173406 0.0029639 5.851 4.90e-09 ***
## Intervention_Redefined 0.0151905 0.0070978 2.140 0.032341 *
## lag_num_pd_w_tx -0.0180270 0.0006636 -27.165 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(Time_Period_ID):as.factor(Region)Midwest 8.530 8.932 3285 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.641 8.960 2127 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 8.681 8.969 3411 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 8.911 8.998 1468 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.882 Deviance explained = 87.3%
## UBRE = 5.5488 Scale est. = 1 n = 14806.10.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_sensitivity_anlys_post_tx_logistic_smoothed_time_subset <-
data.frame(predict(sensitivity_anlys_post_tx_model_logistic_smoothed_time_subset, type = "lpmatrix"))
#estimate the 95% CI and SD
coefficient_values_sensitivity_anlys_post_tx_logistic_smoothed_time_subset <- coef(sensitivity_anlys_post_tx_model_logistic_smoothed_time_subset)
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset_w_cov <-
compute_sd_and_CI(as.matrix(full_df_w_basis_functions_sensitivity_anlys_post_tx_logistic_smoothed_time_subset),
log(data_subset$prop_dead),
coefficient_values_sensitivity_anlys_post_tx_logistic_smoothed_time_subset,
k = ncol(full_df_w_basis_functions_sensitivity_anlys_post_tx_logistic_smoothed_time_subset),
print_full_cov = TRUE)
# sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset <-
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset_w_cov[[1]]
colnames(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset) <- c("conf.low", "estimate", "conf.high", "sd")
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term <- rownames(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset)
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$ci_95 <-
paste("95% CI = (", format(round(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.low, 3), nsmall = 3), ", ",
format(round(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
Linear Intervention, Subset Data") +
scale_color_grey() +
geom_text(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_logistic_all_yr_subset <- sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset[51:66,]
table_of_RR_lin_eff_logistic_all_yr_subset$estimate <- round(exp(table_of_RR_lin_eff_logistic_all_yr_subset$estimate), 3)
table_of_RR_lin_eff_logistic_all_yr_subset$conf.low <- exp(table_of_RR_lin_eff_logistic_all_yr_subset$conf.low)
table_of_RR_lin_eff_logistic_all_yr_subset$conf.high <- exp(table_of_RR_lin_eff_logistic_all_yr_subset$conf.high)
table_of_RR_lin_eff_logistic_all_yr_subset$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_logistic_all_yr_subset$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_logistic_all_yr_subset$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_logistic_all_yr_subset, "./Data/table_of_RR_lin_eff_logistic_all_yr_subset_5_9_22.csv")6.10.2 Attributable Deaths
date_data_subset <- data_subset[, c("Time_Period_ID", "Time_Period_Start")]
date_data_subset <- date_data_subset[!duplicated(date_data_subset),]
var_cov_mat_beta_logistic_tx_subset <- as.matrix(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset_w_cov[[2]][
c("Intervention_Redefined", "lag_num_pd_w_tx"), c("Intervention_Redefined", "lag_num_pd_w_tx")])
attr_deaths_est_logistic_smoothed_time_lin_post_subset <- attr_death_compute(data_subset,
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset,
lin_model = TRUE,
tx_name = c("Intervention_Redefined", "lag_num_pd_w_tx"),
var_cov_mat_beta_logistic_tx_subset)
attr_deaths_est_logistic_smoothed_time_lin_post_subset <- merge(attr_deaths_est_logistic_smoothed_time_lin_post_subset, date_data_subset,
by.x = "Time_Period", by.y = "Time_Period_ID")
attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary <- attr_deaths_est_logistic_smoothed_time_lin_post_subset %>%
group_by(year = year(Time_Period_Start)) %>%
summarise(total_attr_deaths = sum(attr_deaths),
total_attr_deaths_lb = sum(attr_deaths_lb),
total_attr_deaths_ub = sum(attr_deaths_ub))
ggplot(attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary, aes(x = year)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Per Year
Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
ggplot() +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths, linetype = "Estimate",
color = "Full Dataset")) +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths_lb, linetype = "95% CI",
color = "Full Dataset")) +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_summary,
mapping = aes(x = year, y = total_attr_deaths_ub, linetype = "95% CI",
color = "Full Dataset")) +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths, linetype = "Estimate",
color = "Subset Dataset")) +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths_lb,
linetype = "95% CI",
color = "Subset Dataset")) +
geom_line(attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary,
mapping = aes(x = year, y = total_attr_deaths_ub,
linetype = "95% CI",
color = "Subset Dataset")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, Linear Policy Effects",
linetype = "", color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
7 OLS Model Two Year With Linear Fixed Time Effects Interacted with Region With Log Proportion
7.1 Create Two Year Data
#create a plot for each state to see how many prosecution media alerts there are per 6 month period
#read in the prosecution media alert data
prosecution_data<-read.csv("./Data/dih_prosecutions_9_6_21.csv")
#data cleaning
prosecution_data<-prosecution_data %>%
mutate(Date = as.Date(Date.charged, "%m/%d/%Y")) %>%
mutate(State = ifelse(State.Filed == "pennsylvania", "Pennsylvania", State.Filed),
State = ifelse(State.Filed == "Virginia ", "Virginia", State)) %>%
filter(!is.na(Date), State.Filed != "No Info", State.Filed != "No info", State.Filed != "No Info ",
State != "")
#clean up the data by looking at the link to the article
prosecution_data$Date[prosecution_data$Date == "2026-08-01"] <- as.Date("2016-02-15", "%Y-%m-%d")
#change the states into Character instead of factor
prosecution_data$State<-as.character(prosecution_data$State)
#see how many prosecution data points there are for each state
table(prosecution_data$State)##
## Alabama Alaska Arizona Arkansas California
## 12 8 9 4 76
## Colorado Connecticut Delaware Florida Georgia
## 32 47 3 138 29
## Idaho Illinois Indiana Iowa Kansas
## 9 342 55 31 9
## Kentucky Louisiana Maine Maryland Massachusetts
## 43 65 17 63 34
## Michigan Minnesota Mississippi Missouri Montana
## 116 140 1 45 11
## Nebraska Nevada New Hampshire New Jersey New Mexico
## 1 13 42 137 4
## New York North Carolina North Dakota Ohio Oklahoma
## 110 124 53 404 41
## Oregon Pennsylvania Rhode Island South Carolina South Dakota
## 19 726 2 12 13
## Tennessee Texas Utah Vermont Virginia
## 94 44 21 13 63
## Washington West Virginia Wisconsin Wyoming
## 78 33 381 19#there are some repeated cases depending on victim
prosecution_data_unique <- prosecution_data %>%
group_by(State) %>%
distinct(Accused.Name, Date, .keep_all = T)
table(prosecution_data_unique$State)##
## Alabama Alaska Arizona Arkansas California
## 12 8 9 4 72
## Colorado Connecticut Delaware Florida Georgia
## 30 46 3 134 26
## Idaho Illinois Indiana Iowa Kansas
## 9 336 53 31 9
## Kentucky Louisiana Maine Maryland Massachusetts
## 43 65 17 62 34
## Michigan Minnesota Mississippi Missouri Montana
## 114 140 1 44 10
## Nebraska Nevada New Hampshire New Jersey New Mexico
## 1 13 42 131 4
## New York North Carolina North Dakota Ohio Oklahoma
## 105 121 40 395 34
## Oregon Pennsylvania Rhode Island South Carolina South Dakota
## 19 718 2 12 13
## Tennessee Texas Utah Vermont Virginia
## 94 43 21 13 63
## Washington West Virginia Wisconsin Wyoming
## 75 33 373 19#change date charged into Date object
prosecution_data_unique$Date<-mdy(prosecution_data_unique$Date.charged)
#group the data into six month periods
prosecution_data_unique<-prosecution_data_unique %>%
mutate(six_month_pd = lubridate::floor_date(Date , "6 months" ))
#count the number of prosecution media alerts in each six month period
#we also get the first and last date of prosecution in time period
prosecution_data_by_six_month_pd <- prosecution_data_unique %>%
filter(year(six_month_pd)>1999 & year(six_month_pd)<2020) %>%
group_by(State, six_month_pd) %>%
summarise(first_date_in_pd = min(Date), last_date_in_pd = max(Date))
#create the data set used for this sensitivity analysis
#first, we merge the grouped prosecution data set with the main data set by state and time period
sensitivity_anlys_redefine_int_data<-merge(main_analysis_data,
prosecution_data_by_six_month_pd,
by.x = c("State", "Time_Period_Start"),
by.y = c("State", "six_month_pd"), all = TRUE)
#create a intervention 2 year effect variable by initializing it to be all 0
sensitivity_anlys_redefine_int_data<-sensitivity_anlys_redefine_int_data %>%
group_by(State) %>%
mutate(int_2_yr_effect = 0)
#change the date into a date object
sensitivity_anlys_redefine_int_data$Time_Period_Start<-as.Date(sensitivity_anlys_redefine_int_data$Time_Period_Start)
sensitivity_anlys_redefine_int_data$Time_Period_End<-as.Date(sensitivity_anlys_redefine_int_data$Time_Period_End)
#we need to impute the newly defined intervention variable depending on the case
#by examining each row of the data set
for(state in unique(sensitivity_anlys_redefine_int_data$State)){
#first, subset the data set into state_data which only contains the data for the state
state_index<-which(sensitivity_anlys_redefine_int_data$State == state)
state_data<-sensitivity_anlys_redefine_int_data[state_index,]
#note that the first four rows of the 2 year effect intervention variable are the same as the
#first four rows of the original intervention variable
state_data$int_2_yr_effect[1:4]<-state_data$Intervention_Redefined[1:4]
for(i in 5:nrow(state_data)){
#next, we deal with the rows where there was at least one prosecution in the last 3 six month periods
#These rows will be imputed with a 1
if((!is.na(state_data$first_date_in_pd[i - 1]) |
!is.na(state_data$first_date_in_pd[i - 2]) |
!is.na(state_data$first_date_in_pd[i - 3]))){
state_data$int_2_yr_effect[i]<-1
}else{
#next, we account for the rows with the fractions:
# 1) an intervention occurs in row i without an intervention 2 years ago
# 2) row i contains the lasting effects of an intervention that occurred 2 years ago
# 3) row i contains effects from both a new intervention starting in row i and lasting
# effects from 2 years ago
#To compute the fraction, we add the number of days that are affected by an intervention
#(from both the current prosecution and previous prosecution) and then divide by the total
#number of days in the period:
total_len_of_pd<-as.numeric(state_data$Time_Period_End[i] - state_data$Time_Period_Start[i])
#If there is no prosecution two years ago, i.e. in period i-4, then the last_date is the first
#date in period i. We subtract the last_date by the first date in the period, so we will get
#a 0 for the number of days that are affected by a prosecution from period i-4. Otherwise,
#the last_date is the last date of prosecution from period i-4, plus 2 years.
len_of_past_effect <- ifelse(!is.na(state_data$first_date_in_pd[i - 4]),
(state_data$last_date_in_pd[i - 4] + years(2)) - state_data$Time_Period_Start[i],
0)
#If there is no prosecution in the period i, then the start_date is the last date in the period i.
#We subtract start_date from the last date in period i, so we will get a 0 for the number
#of days that are affected by a prosecution in period i. Otherwise, the start_date is the
#first date of a prosecution in period i.
len_of_current_effect <- ifelse(!is.na(state_data$first_date_in_pd[i]),
as.numeric(state_data$Time_Period_End[i] - state_data$first_date_in_pd[i]),
0)
state_data$int_2_yr_effect[i]<-(len_of_past_effect + len_of_current_effect)/total_len_of_pd
}
}
#for the case where the int_2_yr_effect is greater than 1 (could result when we add the effects of
#previous intervention and the current intervention), we just impute a 1 instead
state_data$int_2_yr_effect[state_data$int_2_yr_effect>1]<-1
#lastly, we store the int_2_yr_effect variable into the sensitivity analysis data set
sensitivity_anlys_redefine_int_data$int_2_yr_effect[state_index]<-state_data$int_2_yr_effect
}
#view the data set just to make sure the imputation looks right
# View(sensitivity_anlys_redefine_int_data %>% select(State, Time_Period_Start, Time_Period_End,
# Intervention_Redefined, first_date_in_pd,
# last_date_in_pd,
# int_2_yr_effect))
sensitivity_anlys_redefine_int_data <- sensitivity_anlys_redefine_int_data %>%
group_by(Time_Period_Start) %>%
mutate(num_states_w_intervention_2_yr_effect = sum(int_2_yr_effect))7.2 Constant Effect Model
#compute the proportion of people who died from drug overdose
sensitivity_anlys_redefine_int_data$prop_dead <- sensitivity_anlys_redefine_int_data$imputed_deaths/
sensitivity_anlys_redefine_int_data$population
#fit an OLS with smoothed time effects
sensitivity_analysis_model_log_fixed_lin_time<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
Naloxone_Pharmacy_No_Redefined +
Medical_Marijuana_Redefined +
Recreational_Marijuana_Redefined +
GSL_Redefined +
PDMP_Redefined +
Medicaid_Expansion_Redefined +
int_2_yr_effect ,
data = sensitivity_anlys_redefine_int_data)
summary(sensitivity_analysis_model_log_fixed_lin_time)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + Naloxone_Pharmacy_No_Redefined +
## Medical_Marijuana_Redefined + Recreational_Marijuana_Redefined +
## GSL_Redefined + PDMP_Redefined + Medicaid_Expansion_Redefined +
## int_2_yr_effect
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.732282 0.051886 -187.572 < 2e-16 ***
## StateAlaska 0.176722 0.074100 2.385 0.017179 *
## StateArizona 0.297802 0.067750 4.396 1.17e-05 ***
## StateArkansas -0.477487 0.067136 -7.112 1.61e-12 ***
## StateCalifornia -0.165868 0.074090 -2.239 0.025286 *
## StateColorado 0.041510 0.074070 0.560 0.575264
## StateConnecticut 0.229267 0.070940 3.232 0.001251 **
## StateDelaware 0.231337 0.067625 3.421 0.000637 ***
## StateFlorida 0.293030 0.066878 4.382 1.24e-05 ***
## StateGeorgia -0.011678 0.066057 -0.177 0.859698
## StateHawaii -0.357184 0.072354 -4.937 8.64e-07 ***
## StateIdaho -0.109878 0.066484 -1.653 0.098555 .
## StateIllinois 0.149450 0.067847 2.203 0.027732 *
## StateIndiana 0.085052 0.066309 1.283 0.199766
## StateIowa -0.682383 0.066539 -10.255 < 2e-16 ***
## StateKansas -0.227955 0.066228 -3.442 0.000590 ***
## StateKentucky 0.708997 0.066651 10.638 < 2e-16 ***
## StateLouisiana 0.332686 0.065948 5.045 4.97e-07 ***
## StateMaine 0.090388 0.073887 1.223 0.221354
## StateMaryland -1.524942 0.067627 -22.549 < 2e-16 ***
## StateMassachusetts -0.082850 0.067360 -1.230 0.218863
## StateMichigan 0.004729 0.068479 0.069 0.944949
## StateMinnesota -0.645614 0.069958 -9.229 < 2e-16 ***
## StateMississippi -0.035631 0.066179 -0.538 0.590357
## StateMissouri 0.161791 0.068241 2.371 0.017845 *
## StateMontana -0.446753 0.070067 -6.376 2.27e-10 ***
## StateNebraska -0.862333 0.067404 -12.794 < 2e-16 ***
## StateNevada 0.457017 0.071694 6.375 2.29e-10 ***
## StateNew Hampshire 0.150070 0.067115 2.236 0.025466 *
## StateNew Jersey 0.071248 0.067671 1.053 0.292541
## StateNew Mexico 0.651578 0.073136 8.909 < 2e-16 ***
## StateNew York -0.140484 0.068388 -2.054 0.040091 *
## StateNorth Carolina 0.227446 0.065851 3.454 0.000564 ***
## StateNorth Dakota -1.129127 0.066271 -17.038 < 2e-16 ***
## StateOhio 0.437070 0.067004 6.523 8.79e-11 ***
## StateOklahoma 0.470225 0.066373 7.085 1.95e-12 ***
## StateOregon -0.269650 0.073841 -3.652 0.000267 ***
## StatePennsylvania 0.546397 0.066969 8.159 6.04e-16 ***
## StateRhode Island -0.266728 0.069446 -3.841 0.000127 ***
## StateSouth Carolina 0.222407 0.066049 3.367 0.000774 ***
## StateSouth Dakota -1.011264 0.066381 -15.234 < 2e-16 ***
## StateTennessee 0.470629 0.065763 7.156 1.17e-12 ***
## StateTexas -0.029320 0.066410 -0.442 0.658899
## StateUtah -0.098664 0.065991 -1.495 0.135049
## StateVermont -0.166096 0.069776 -2.380 0.017390 *
## StateVirginia -0.040830 0.065975 -0.619 0.536080
## StateWashington 0.044179 0.075280 0.587 0.557361
## StateWest Virginia 0.799647 0.066602 12.006 < 2e-16 ***
## StateWisconsin -0.002745 0.066233 -0.041 0.966943
## StateWyoming -0.017430 0.066089 -0.264 0.792015
## Naloxone_Pharmacy_Yes_Redefined -0.082459 0.042748 -1.929 0.053882 .
## Naloxone_Pharmacy_No_Redefined -0.005978 0.038644 -0.155 0.877073
## Medical_Marijuana_Redefined 0.193591 0.030661 6.314 3.37e-10 ***
## Recreational_Marijuana_Redefined -0.114103 0.048891 -2.334 0.019708 *
## GSL_Redefined 0.057993 0.031575 1.837 0.066410 .
## PDMP_Redefined -0.154318 0.024687 -6.251 5.01e-10 ***
## Medicaid_Expansion_Redefined 0.090679 0.030122 3.010 0.002643 **
## int_2_yr_effect 0.012986 0.021508 0.604 0.546043
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 4.777 5.834 145.24 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.468 8.918 84.05 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 6.291 7.433 109.20 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 3.421 4.263 86.60 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.84 Deviance explained = 84.6%
## GCV = 0.08963 Scale est. = 0.086002 n = 2000#examine fitted values
summary(fitted(sensitivity_analysis_model_log_fixed_lin_time))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -12.327 -10.207 -9.740 -9.796 -9.343 -8.133hist(fitted(sensitivity_analysis_model_log_fixed_lin_time))
par(mfrow = c(2,2))
plot(sensitivity_analysis_model_log_fixed_lin_time)
7.2.1 Coefficients and 95% CI
#compute the full dataset including basis functions
full_df_w_basis_functions_log_fixed_lin_time_2_yr <- model.matrix(sensitivity_analysis_model_log_fixed_lin_time)
#estimate the 95% CI and SD
coefficient_values_log_fixed_lin_time_sens_anlys <- coef(sensitivity_analysis_model_log_fixed_lin_time)
#type = "response" to get the estimated probabilities
sens_analysis_sd_and_ci_log_fixed_lin_time <- compute_sd_and_CI(full_df_w_basis_functions_log_fixed_lin_time_2_yr,
log(sensitivity_anlys_redefine_int_data$prop_dead),
coefficient_values_log_fixed_lin_time_sens_anlys,
k = ncol(full_df_w_basis_functions_log_fixed_lin_time_2_yr))
colnames(sens_analysis_sd_and_ci_log_fixed_lin_time) <- c("conf.low", "estimate", "conf.high", "sd")
sens_analysis_sd_and_ci_log_fixed_lin_time$term <- rownames(sens_analysis_sd_and_ci_log_fixed_lin_time)
sens_analysis_sd_and_ci_log_fixed_lin_time$ci_95 <-
paste("95% CI = (", format(round(sens_analysis_sd_and_ci_log_fixed_lin_time$conf.low, 3), nsmall = 3), ", ",
format(round(sens_analysis_sd_and_ci_log_fixed_lin_time$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sens_analysis_sd_and_ci_log_fixed_lin_time[51:58,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Effects,
2 Year Exposure Intervention") +
scale_color_grey() +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time[51:58,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 8:1), size = 3) +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time[51:58,],
mapping = aes(label = ci_95, x = 0.9, y = 8:1), size = 3) +
xlim(-.3, 1.1)
7.2.2 Attributable Deaths
date_data_sens_anlys <- sensitivity_anlys_redefine_int_data[, c("Time_Period_ID", "Time_Period_Start")]
date_data_sens_anlys <- date_data_sens_anlys[!duplicated(date_data_sens_anlys),]
attr_deaths_est_log_lin_time <- attr_death_compute(sensitivity_anlys_redefine_int_data,
sens_analysis_sd_and_ci_log_fixed_lin_time,
lin_model = TRUE,
tx_name = "int_2_yr_effect")
attr_deaths_est_log_lin_time_sens_anlys <- merge(attr_deaths_est_log_lin_time, date_data_sens_anlys,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_log_lin_time_sens_anlys, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, 2 Year Effect",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
7.3 Create Linear Trend Data
#use this function to compute the cumulative sum, but resets the sum if the variable was 0
compute_cumsum = function(x){
cs = cumsum(x)
cs - cummax((x == 0) * cs)
}
sensitivity_anlys_event_study_data_lin_post_tx_2yr <- sensitivity_anlys_redefine_int_data %>%
arrange(State, Time_Period_ID) %>%
group_by(State) %>%
mutate(num_pd_w_tx = compute_cumsum(int_2_yr_effect),
num_pd_w_naloxone_yes = compute_cumsum(Naloxone_Pharmacy_Yes_Redefined),
num_pd_w_naloxone_no = compute_cumsum(Naloxone_Pharmacy_No_Redefined),
num_pd_w_med_marijuana = compute_cumsum(Medical_Marijuana_Redefined),
num_pd_w_rec_marijuana = compute_cumsum(Recreational_Marijuana_Redefined),
num_pd_w_gsl = compute_cumsum(GSL_Redefined),
num_pd_w_pdmp = compute_cumsum(PDMP_Redefined),
num_pd_w_medicaid = compute_cumsum(Medicaid_Expansion_Redefined),
lag_num_pd_w_tx = lag(num_pd_w_tx),
lag_num_pd_w_naloxone_yes = lag(num_pd_w_naloxone_yes),
lag_num_pd_w_naloxone_no = lag(num_pd_w_naloxone_no),
lag_num_pd_w_med_marijuana = lag(num_pd_w_med_marijuana),
lag_num_pd_w_rec_marijuana = lag(num_pd_w_rec_marijuana),
lag_num_pd_w_gsl = lag(num_pd_w_gsl),
lag_num_pd_w_pdmp = lag(num_pd_w_pdmp),
lag_num_pd_w_medicaid = lag(num_pd_w_medicaid)) #lag so that intercept = effect when tx first occurs
#fill in a 0 for the NAs so we keep all the data and at most this will be 0
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_tx[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Intervention_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_naloxone_yes[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Naloxone_Pharmacy_Yes_Redefined < 1]<-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_naloxone_no[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Naloxone_Pharmacy_No_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_med_marijuana[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Medical_Marijuana_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_rec_marijuana[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Recreational_Marijuana_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_gsl[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$GSL_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_pdmp[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$PDMP_Redefined < 1] <-
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_medicaid[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$Medicaid_Expansion_Redefined < 1] <-0
#for the linear effects, we want the 2 year effect variable to be 0 when treatment is 0
sensitivity_anlys_event_study_data_lin_post_tx_2yr$lag_num_pd_w_tx[
sensitivity_anlys_event_study_data_lin_post_tx_2yr$int_2_yr_effect == 0] <- 07.4 Model
#run the gam model
sensitivity_anlys_lin_post_tx_model_log_smoothed_time_2yr<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
int_2_yr_effect +
lag_num_pd_w_tx,
data = sensitivity_anlys_event_study_data_lin_post_tx_2yr)
summary(sensitivity_anlys_lin_post_tx_model_log_smoothed_time_2yr)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + lag_num_pd_w_naloxone_yes +
## Naloxone_Pharmacy_No_Redefined + lag_num_pd_w_naloxone_no +
## Medical_Marijuana_Redefined + lag_num_pd_w_med_marijuana +
## Recreational_Marijuana_Redefined + lag_num_pd_w_rec_marijuana +
## GSL_Redefined + lag_num_pd_w_gsl + PDMP_Redefined + lag_num_pd_w_pdmp +
## Medicaid_Expansion_Redefined + lag_num_pd_w_medicaid + int_2_yr_effect +
## lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.8016408 0.0603781 -162.338 < 2e-16 ***
## StateAlaska 0.2565205 0.0831882 3.084 0.002075 **
## StateArizona 0.3146632 0.0661622 4.756 2.12e-06 ***
## StateArkansas -0.4549501 0.0676579 -6.724 2.33e-11 ***
## StateCalifornia -0.1176174 0.0839782 -1.401 0.161507
## StateColorado 0.1146721 0.0788744 1.454 0.146152
## StateConnecticut 0.3063227 0.0726409 4.217 2.59e-05 ***
## StateDelaware 0.2721045 0.0674638 4.033 5.72e-05 ***
## StateFlorida 0.4583158 0.0708122 6.472 1.23e-10 ***
## StateGeorgia 0.0791306 0.0667120 1.186 0.235711
## StateHawaii -0.3283111 0.0852120 -3.853 0.000121 ***
## StateIdaho -0.1840170 0.0691457 -2.661 0.007850 **
## StateIllinois 0.2602359 0.0750998 3.465 0.000542 ***
## StateIndiana 0.0244260 0.0688179 0.355 0.722676
## StateIowa -0.6577224 0.0644710 -10.202 < 2e-16 ***
## StateKansas -0.2122227 0.0646445 -3.283 0.001046 **
## StateKentucky 0.6504241 0.0690747 9.416 < 2e-16 ***
## StateLouisiana 0.3682382 0.0636885 5.782 8.62e-09 ***
## StateMaine 0.2210305 0.0836490 2.642 0.008301 **
## StateMaryland -1.4972262 0.0692611 -21.617 < 2e-16 ***
## StateMassachusetts -0.1690128 0.0701129 -2.411 0.016022 *
## StateMichigan 0.0100106 0.0734036 0.136 0.891537
## StateMinnesota -0.5358930 0.0712043 -7.526 8.04e-14 ***
## StateMississippi -0.0552243 0.0635471 -0.869 0.384941
## StateMissouri 0.2880831 0.0738737 3.900 9.97e-05 ***
## StateMontana -0.3022387 0.0740810 -4.080 4.69e-05 ***
## StateNebraska -0.8363314 0.0676704 -12.359 < 2e-16 ***
## StateNevada 0.4478611 0.0812396 5.513 4.02e-08 ***
## StateNew Hampshire 0.2365112 0.0683898 3.458 0.000556 ***
## StateNew Jersey 0.1125847 0.0663249 1.697 0.089772 .
## StateNew Mexico 0.6914790 0.0793237 8.717 < 2e-16 ***
## StateNew York -0.2494378 0.0711911 -3.504 0.000469 ***
## StateNorth Carolina 0.2634269 0.0635776 4.143 3.57e-05 ***
## StateNorth Dakota -1.1415178 0.0637344 -17.911 < 2e-16 ***
## StateOhio 0.5811796 0.0695838 8.352 < 2e-16 ***
## StateOklahoma 0.4220487 0.0690067 6.116 1.16e-09 ***
## StateOregon -0.0467051 0.0822708 -0.568 0.570306
## StatePennsylvania 0.6086714 0.0738247 8.245 3.06e-16 ***
## StateRhode Island -0.2622975 0.0747520 -3.509 0.000460 ***
## StateSouth Carolina 0.2182717 0.0635182 3.436 0.000602 ***
## StateSouth Dakota -0.9755882 0.0659198 -14.800 < 2e-16 ***
## StateTennessee 0.4438194 0.0639161 6.944 5.23e-12 ***
## StateTexas -0.0603077 0.0692513 -0.871 0.383945
## StateUtah -0.1783509 0.0689030 -2.588 0.009715 **
## StateVermont -0.0869026 0.0705338 -1.232 0.218076
## StateVirginia 0.0106720 0.0666013 0.160 0.872712
## StateWashington 0.1415374 0.0810681 1.746 0.080990 .
## StateWest Virginia 0.7132549 0.0693991 10.278 < 2e-16 ***
## StateWisconsin 0.1312001 0.0680598 1.928 0.054040 .
## StateWyoming -0.0559858 0.0641792 -0.872 0.383136
## Naloxone_Pharmacy_Yes_Redefined -0.0556536 0.0421378 -1.321 0.186744
## lag_num_pd_w_naloxone_yes -0.0285747 0.0066092 -4.323 1.62e-05 ***
## Naloxone_Pharmacy_No_Redefined 0.1220399 0.0434310 2.810 0.005006 **
## lag_num_pd_w_naloxone_no -0.0221860 0.0045497 -4.876 1.17e-06 ***
## Medical_Marijuana_Redefined 0.1991293 0.0304565 6.538 7.99e-11 ***
## lag_num_pd_w_med_marijuana -0.0083811 0.0022239 -3.769 0.000169 ***
## Recreational_Marijuana_Redefined -0.0349421 0.0614315 -0.569 0.569561
## lag_num_pd_w_rec_marijuana -0.0002178 0.0109761 -0.020 0.984173
## GSL_Redefined 0.0847980 0.0329650 2.572 0.010176 *
## lag_num_pd_w_gsl 0.0102671 0.0040724 2.521 0.011780 *
## PDMP_Redefined -0.1227586 0.0271925 -4.514 6.74e-06 ***
## lag_num_pd_w_pdmp 0.0072700 0.0024211 3.003 0.002711 **
## Medicaid_Expansion_Redefined 0.0795666 0.0335742 2.370 0.017894 *
## lag_num_pd_w_medicaid 0.0153612 0.0050474 3.043 0.002372 **
## int_2_yr_effect 0.0465435 0.0208954 2.227 0.026034 *
## lag_num_pd_w_tx -0.0116242 0.0018350 -6.335 2.96e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 4.124 5.102 90.93 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.422 8.905 43.37 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 6.397 7.545 48.20 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 4.447 5.494 30.11 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.85 Deviance explained = 85.7%
## GCV = 0.082683 Scale est. = 0.07895 n = 1980plot(sensitivity_anlys_lin_post_tx_model_log_smoothed_time_2yr, pages = 1)
7.4.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_2_yr <- model.matrix(sensitivity_anlys_lin_post_tx_model_log_smoothed_time_2yr)
#estimate the 95% CI and SD
coefficient_values_log_fixed_lin_time_lin_post_tx_2yr <- coef(sensitivity_anlys_lin_post_tx_model_log_smoothed_time_2yr)
#type = "response" to get the estimated probabilities
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_w_cov <-
compute_sd_and_CI(full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_2_yr,
log(sensitivity_anlys_event_study_data_lin_post_tx_2yr$prop_dead),
coefficient_values_log_fixed_lin_time_lin_post_tx_2yr,
k = ncol(full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_2_yr),
print_full_cov = TRUE)
# format(round(main_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx,4)
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx <- sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_w_cov[[1]]
colnames(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx) <- c("conf.low", "estimate", "conf.high", "sd")
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term <- rownames(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx)
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$ci_95 <-
paste("95% CI = (", format(round(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low, 3), nsmall = 3), ", ",
format(round(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
2 Year Linear Intervention") +
scale_color_grey() +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.3, 1.1)
table_of_RR_lin_eff_log_2_yr <- sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx[51:66,]
table_of_RR_lin_eff_log_2_yr$estimate <- round(exp(table_of_RR_lin_eff_log_2_yr$estimate), 3)
table_of_RR_lin_eff_log_2_yr$conf.low <- exp(table_of_RR_lin_eff_log_2_yr$conf.low)
table_of_RR_lin_eff_log_2_yr$conf.high <- exp(table_of_RR_lin_eff_log_2_yr$conf.high)
table_of_RR_lin_eff_log_2_yr$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_log_2_yr$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_log_2_yr$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_log_2_yr, "./Data/table_of_RR_lin_eff_log_2_yr_5_9_22.csv")7.4.2 Plot Effects
plot_data <- data.frame(time_after_tx = 0:38,
coef = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38),
conf.low = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38),
conf.high = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38))
ggplot(plot_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect")) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
title = "Estimated Effect of DIH Prosecutions Reported in the Media on
Drug OD Deaths by Number of Periods After Exposure,
Assuming Two Year Effect") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted")
7.4.3 Attributable Deaths
date_data_2yr <- sensitivity_anlys_event_study_data_lin_post_tx_2yr[, c("Time_Period_ID", "Time_Period_Start")]
date_data_2yr <- date_data_2yr[!duplicated(date_data_2yr),]
var_cov_mat_beta_lin_tx_two_yr <- as.matrix(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_w_cov[[2]][
c("int_2_yr_effect", "lag_num_pd_w_tx"), c("int_2_yr_effect", "lag_num_pd_w_tx")])
attr_deaths_est_log_lin_time_lin_post_tx_2yr <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx_2yr,
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx,
lin_model = TRUE,
tx_name = c("int_2_yr_effect", "lag_num_pd_w_tx"),
var_cov_mat_beta_lin_tx_two_yr)
attr_deaths_est_log_lin_time_lin_post_tx_2yr <- merge(attr_deaths_est_log_lin_time_lin_post_tx_2yr, date_data_2yr,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_log_lin_time_lin_post_tx_2yr, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
7.5 Linear Policy Measures Post Tx Subset
sens_data_subset <- sensitivity_anlys_event_study_data_lin_post_tx_2yr %>%
filter(Time_Period_ID <= 30)
#run the gam model
sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr<-gam(log(prop_dead)~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
int_2_yr_effect +
lag_num_pd_w_tx,
data = sens_data_subset)
summary(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)##
## Family: gaussian
## Link function: identity
##
## Formula:
## log(prop_dead) ~ State + s(Time_Period_ID, bs = "cr", by = as.factor(Region)) +
## Naloxone_Pharmacy_Yes_Redefined + lag_num_pd_w_naloxone_yes +
## Naloxone_Pharmacy_No_Redefined + lag_num_pd_w_naloxone_no +
## Medical_Marijuana_Redefined + lag_num_pd_w_med_marijuana +
## Recreational_Marijuana_Redefined + lag_num_pd_w_rec_marijuana +
## GSL_Redefined + lag_num_pd_w_gsl + PDMP_Redefined + lag_num_pd_w_pdmp +
## Medicaid_Expansion_Redefined + lag_num_pd_w_medicaid + int_2_yr_effect +
## lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -10.021226 0.059923 -167.236 < 2e-16 ***
## StateAlaska 0.443918 0.095754 4.636 3.88e-06 ***
## StateArizona 0.440959 0.074410 5.926 3.90e-09 ***
## StateArkansas -0.389547 0.076027 -5.124 3.41e-07 ***
## StateCalifornia 0.026610 0.098589 0.270 0.787267
## StateColorado 0.249046 0.090536 2.751 0.006022 **
## StateConnecticut 0.475997 0.085658 5.557 3.28e-08 ***
## StateDelaware 0.220355 0.076352 2.886 0.003961 **
## StateFlorida 0.597255 0.082492 7.240 7.37e-13 ***
## StateGeorgia 0.137253 0.076182 1.802 0.071816 .
## StateHawaii -0.294001 0.097338 -3.020 0.002570 **
## StateIdaho -0.214477 0.079981 -2.682 0.007413 **
## StateIllinois 0.339921 0.087098 3.903 9.96e-05 ***
## StateIndiana -0.098791 0.079538 -1.242 0.214423
## StateIowa -0.649208 0.073157 -8.874 < 2e-16 ***
## StateKansas -0.132411 0.073982 -1.790 0.073709 .
## StateKentucky 0.629274 0.079648 7.901 5.58e-15 ***
## StateLouisiana 0.401089 0.073403 5.464 5.50e-08 ***
## StateMaine 0.149907 0.094182 1.592 0.111686
## StateMaryland -1.709234 0.078727 -21.711 < 2e-16 ***
## StateMassachusetts -0.369406 0.080232 -4.604 4.52e-06 ***
## StateMichigan -0.038650 0.082294 -0.470 0.638671
## StateMinnesota -0.501390 0.081363 -6.162 9.36e-10 ***
## StateMississippi 0.029578 0.073196 0.404 0.686205
## StateMissouri 0.295634 0.078749 3.754 0.000181 ***
## StateMontana -0.170564 0.082931 -2.057 0.039899 *
## StateNebraska -0.771116 0.076030 -10.142 < 2e-16 ***
## StateNevada 0.594454 0.092584 6.421 1.85e-10 ***
## StateNew Hampshire 0.161648 0.076915 2.102 0.035763 *
## StateNew Jersey 0.088110 0.075402 1.169 0.242786
## StateNew Mexico 1.076203 0.096501 11.152 < 2e-16 ***
## StateNew York -0.208848 0.083520 -2.501 0.012513 *
## StateNorth Carolina 0.290062 0.073784 3.931 8.86e-05 ***
## StateNorth Dakota -1.214520 0.073058 -16.624 < 2e-16 ***
## StateOhio 0.580702 0.081050 7.165 1.26e-12 ***
## StateOklahoma 0.444811 0.079529 5.593 2.68e-08 ***
## StateOregon 0.119127 0.095563 1.247 0.212757
## StatePennsylvania 0.609442 0.085881 7.096 2.03e-12 ***
## StateRhode Island -0.529456 0.084963 -6.232 6.10e-10 ***
## StateSouth Carolina 0.233586 0.073378 3.183 0.001488 **
## StateSouth Dakota -0.992709 0.075504 -13.148 < 2e-16 ***
## StateTennessee 0.403206 0.073918 5.455 5.79e-08 ***
## StateTexas -0.022492 0.079614 -0.283 0.777589
## StateUtah -0.286627 0.079529 -3.604 0.000324 ***
## StateVermont -0.076646 0.080670 -0.950 0.342217
## StateVirginia -0.024922 0.076636 -0.325 0.745080
## StateWashington 0.384516 0.093990 4.091 4.54e-05 ***
## StateWest Virginia 0.664839 0.079753 8.336 < 2e-16 ***
## StateWisconsin 0.142372 0.078046 1.824 0.068333 .
## StateWyoming -0.010003 0.073674 -0.136 0.892015
## Naloxone_Pharmacy_Yes_Redefined -0.230136 0.075690 -3.040 0.002406 **
## lag_num_pd_w_naloxone_yes -0.044997 0.023372 -1.925 0.054398 .
## Naloxone_Pharmacy_No_Redefined 0.147979 0.055249 2.678 0.007484 **
## lag_num_pd_w_naloxone_no -0.042004 0.005732 -7.327 3.95e-13 ***
## Medical_Marijuana_Redefined 0.231345 0.039761 5.818 7.36e-09 ***
## lag_num_pd_w_med_marijuana -0.015498 0.003114 -4.977 7.24e-07 ***
## Recreational_Marijuana_Redefined -0.192066 0.188950 -1.016 0.309573
## lag_num_pd_w_rec_marijuana 0.013613 0.090508 0.150 0.880463
## GSL_Redefined 0.127868 0.054818 2.333 0.019812 *
## lag_num_pd_w_gsl 0.012098 0.009971 1.213 0.225208
## PDMP_Redefined -0.106932 0.029467 -3.629 0.000295 ***
## lag_num_pd_w_pdmp 0.013180 0.002810 4.690 3.00e-06 ***
## Medicaid_Expansion_Redefined 0.035884 0.050600 0.709 0.478337
## lag_num_pd_w_medicaid 0.021458 0.015053 1.425 0.154249
## int_2_yr_effect 0.040521 0.024434 1.658 0.097466 .
## lag_num_pd_w_tx -0.019017 0.002933 -6.483 1.24e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time_Period_ID):as.factor(Region)Midwest 2.699 3.371 115.03 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 7.704 8.567 34.27 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 3.049 3.796 74.54 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 3.067 3.826 39.26 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.831 Deviance explained = 84%
## GCV = 0.084059 Scale est. = 0.079372 n = 14807.5.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_subset_2yr <-
model.matrix(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)
#estimate the 95% CI and SD
coefficient_values_log_fixed_lin_time_lin_post_tx_subset_2yr <- coef(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)
#type = "response" to get the estimated probabilities
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset_w_cov <-
compute_sd_and_CI(full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_subset_2yr,
log(sens_data_subset$prop_dead),
coefficient_values_log_fixed_lin_time_lin_post_tx_subset_2yr,
k = ncol(full_df_w_basis_functions_log_fixed_lin_time_lin_post_tx_subset_2yr),
print_full_cov = TRUE)
# format(round(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset,4)
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset <-
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset_w_cov[[1]]
colnames(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset) <- c("conf.low", "estimate", "conf.high", "sd")
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term <-
rownames(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset)
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$ci_95 <-
paste("95% CI = (", format(round(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.low, 3), nsmall = 3), ", ",
format(round(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
2 Year Linear Intervention, Subset Data") +
scale_color_grey() +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_log_2_yr_subset <- sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset[51:66,]
table_of_RR_lin_eff_log_2_yr_subset$estimate <- round(exp(table_of_RR_lin_eff_log_2_yr_subset$estimate), 3)
table_of_RR_lin_eff_log_2_yr_subset$conf.low <- exp(table_of_RR_lin_eff_log_2_yr_subset$conf.low)
table_of_RR_lin_eff_log_2_yr_subset$conf.high <- exp(table_of_RR_lin_eff_log_2_yr_subset$conf.high)
table_of_RR_lin_eff_log_2_yr_subset$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_log_2_yr_subset$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_log_2_yr_subset$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_log_2_yr_subset, "./Data/table_of_RR_lin_eff_log_2_yr_subset_5_9_22.csv")7.5.2 Plot Effects
plot_data_subset_data <- data.frame(time_after_tx = 0:28,
coef = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
conf.low = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
conf.high = sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28))
ggplot(plot_data_subset_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect")) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
title = "Estimated Effect of DIH Prosecutions Reported in the Media on
Drug OD Deaths by Number of Periods After Exposure,
Assuming Two Year Effect, Without Last 5 Years") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted")
7.5.3 Attributable Deaths
date_data_subset_2yr <- sens_data_subset[, c("Time_Period_ID", "Time_Period_Start")]
date_data_subset_2yr <- date_data_subset_2yr[!duplicated(date_data_subset_2yr),]
var_cov_mat_beta_lin_tx_two_yr_subset <- as.matrix(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset_w_cov[[2]][
c("int_2_yr_effect", "lag_num_pd_w_tx"), c("int_2_yr_effect", "lag_num_pd_w_tx")])
attr_deaths_est_log_lin_time_lin_post_tx_subset_2yr <- attr_death_compute(sens_data_subset,
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset,
lin_model = TRUE,
tx_name = c("int_2_yr_effect", "lag_num_pd_w_tx"),
var_cov_mat_beta_lin_tx_two_yr_subset)
attr_deaths_est_log_lin_time_lin_post_tx_subset_2yr <- merge(attr_deaths_est_log_lin_time_lin_post_tx_subset_2yr, date_data_subset_2yr,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_log_lin_time_lin_post_tx_subset_2yr, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
7.6 Logistic Model
#run the gam model
sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time_2yr<-gam(cbind(round(imputed_deaths), round(num_alive))~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
int_2_yr_effect +
lag_num_pd_w_tx,
data = sensitivity_anlys_event_study_data_lin_post_tx_2yr,
family = "binomial")
summary(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time_2yr)##
## Family: binomial
## Link function: logit
##
## Formula:
## cbind(round(imputed_deaths), round(num_alive)) ~ State + s(Time_Period_ID,
## bs = "cr", by = as.factor(Region)) + Naloxone_Pharmacy_Yes_Redefined +
## lag_num_pd_w_naloxone_yes + Naloxone_Pharmacy_No_Redefined +
## lag_num_pd_w_naloxone_no + Medical_Marijuana_Redefined +
## lag_num_pd_w_med_marijuana + Recreational_Marijuana_Redefined +
## lag_num_pd_w_rec_marijuana + GSL_Redefined + lag_num_pd_w_gsl +
## PDMP_Redefined + lag_num_pd_w_pdmp + Medicaid_Expansion_Redefined +
## lag_num_pd_w_medicaid + int_2_yr_effect + lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.8321609 0.0154379 -636.884 < 2e-16 ***
## StateAlaska 0.3218420 0.0307209 10.476 < 2e-16 ***
## StateArizona 0.3163972 0.0145853 21.693 < 2e-16 ***
## StateArkansas -0.3828240 0.0212683 -18.000 < 2e-16 ***
## StateCalifornia -0.1045979 0.0180824 -5.785 7.27e-09 ***
## StateColorado 0.2013450 0.0193117 10.426 < 2e-16 ***
## StateConnecticut 0.1485688 0.0174318 8.523 < 2e-16 ***
## StateDelaware 0.4410561 0.0234040 18.845 < 2e-16 ***
## StateFlorida 0.4159551 0.0144493 28.787 < 2e-16 ***
## StateGeorgia 0.0402410 0.0148633 2.707 0.00678 **
## StateHawaii -0.2349882 0.0289223 -8.125 4.48e-16 ***
## StateIdaho -0.2199773 0.0248543 -8.851 < 2e-16 ***
## StateIllinois 0.1388948 0.0163840 8.477 < 2e-16 ***
## StateIndiana -0.0086600 0.0156521 -0.553 0.58007
## StateIowa -0.7400136 0.0216308 -34.211 < 2e-16 ***
## StateKansas -0.3427351 0.0199412 -17.187 < 2e-16 ***
## StateKentucky 0.5878146 0.0151191 38.879 < 2e-16 ***
## StateLouisiana 0.3355941 0.0144858 23.167 < 2e-16 ***
## StateMaine 0.3049901 0.0262796 11.606 < 2e-16 ***
## StateMaryland -1.0546437 0.0212378 -49.659 < 2e-16 ***
## StateMassachusetts 0.1145138 0.0152728 7.498 6.48e-14 ***
## StateMichigan -0.0022631 0.0163667 -0.138 0.89002
## StateMinnesota -0.5426573 0.0197609 -27.461 < 2e-16 ***
## StateMississippi -0.1307151 0.0182650 -7.157 8.27e-13 ***
## StateMissouri 0.3156684 0.0188963 16.705 < 2e-16 ***
## StateMontana -0.2073809 0.0311345 -6.661 2.72e-11 ***
## StateNebraska -0.9072521 0.0295071 -30.747 < 2e-16 ***
## StateNevada 0.4570621 0.0203505 22.459 < 2e-16 ***
## StateNew Hampshire 0.3587530 0.0214050 16.760 < 2e-16 ***
## StateNew Jersey 0.1508292 0.0143974 10.476 < 2e-16 ***
## StateNew Mexico 0.5461757 0.0194534 28.076 < 2e-16 ***
## StateNew York -0.3575329 0.0144383 -24.763 < 2e-16 ***
## StateNorth Carolina 0.2171845 0.0129294 16.798 < 2e-16 ***
## StateNorth Dakota -1.1155014 0.0455566 -24.486 < 2e-16 ***
## StateOhio 0.5910244 0.0140476 42.073 < 2e-16 ***
## StateOklahoma 0.3578483 0.0163306 21.913 < 2e-16 ***
## StateOregon 0.0307509 0.0222936 1.379 0.16778
## StatePennsylvania 0.5409898 0.0154475 35.021 < 2e-16 ***
## StateRhode Island 0.2405995 0.0239772 10.035 < 2e-16 ***
## StateSouth Carolina 0.1931136 0.0147057 13.132 < 2e-16 ***
## StateSouth Dakota -0.9781675 0.0429151 -22.793 < 2e-16 ***
## StateTennessee 0.4204731 0.0133469 31.503 < 2e-16 ***
## StateTexas -0.1995416 0.0140762 -14.176 < 2e-16 ***
## StateUtah -0.0042427 0.0194295 -0.218 0.82714
## StateVermont -0.0742320 0.0325325 -2.282 0.02250 *
## StateVirginia -0.0385264 0.0149442 -2.578 0.00994 **
## StateWashington 0.1786400 0.0192851 9.263 < 2e-16 ***
## StateWest Virginia 0.7574308 0.0168606 44.923 < 2e-16 ***
## StateWisconsin 0.0861369 0.0160543 5.365 8.08e-08 ***
## StateWyoming -0.0217045 0.0338027 -0.642 0.52081
## Naloxone_Pharmacy_Yes_Redefined -0.0127335 0.0080392 -1.584 0.11321
## lag_num_pd_w_naloxone_yes -0.0248185 0.0011149 -22.261 < 2e-16 ***
## Naloxone_Pharmacy_No_Redefined 0.0532019 0.0079497 6.692 2.20e-11 ***
## lag_num_pd_w_naloxone_no -0.0025223 0.0009291 -2.715 0.00663 **
## Medical_Marijuana_Redefined 0.0499353 0.0058335 8.560 < 2e-16 ***
## lag_num_pd_w_med_marijuana -0.0060568 0.0006409 -9.450 < 2e-16 ***
## Recreational_Marijuana_Redefined -0.0022378 0.0101085 -0.221 0.82480
## lag_num_pd_w_rec_marijuana -0.0123077 0.0019374 -6.353 2.12e-10 ***
## GSL_Redefined 0.0328623 0.0061094 5.379 7.49e-08 ***
## lag_num_pd_w_gsl 0.0126428 0.0008491 14.890 < 2e-16 ***
## PDMP_Redefined -0.0087167 0.0068770 -1.268 0.20497
## lag_num_pd_w_pdmp 0.0062363 0.0006394 9.753 < 2e-16 ***
## Medicaid_Expansion_Redefined 0.0673463 0.0067767 9.938 < 2e-16 ***
## lag_num_pd_w_medicaid 0.0174025 0.0010348 16.818 < 2e-16 ***
## int_2_yr_effect 0.0501628 0.0047647 10.528 < 2e-16 ***
## lag_num_pd_w_tx -0.0092812 0.0003685 -25.184 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(Time_Period_ID):as.factor(Region)Midwest 8.901 8.997 4861 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.938 8.999 3891 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 8.912 8.998 4306 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 8.749 8.980 1773 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.917 Deviance explained = 91.2%
## UBRE = 7.8405 Scale est. = 1 n = 1980plot(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time_2yr, pages = 1)
7.6.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_2_yr <- model.matrix(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time_2yr)
#estimate the 95% CI and SD
coefficient_values_logistic_fixed_lin_time_lin_post_tx_2yr <- coef(sensitivity_anlys_lin_post_tx_model_logistic_smoothed_time_2yr)
#type = "response" to get the estimated probabilities
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_w_cov <-
compute_sd_and_CI(full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_2_yr,
log(sensitivity_anlys_event_study_data_lin_post_tx_2yr$prop_dead),
coefficient_values_logistic_fixed_lin_time_lin_post_tx_2yr,
k = ncol(full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_2_yr),
print_full_cov = TRUE)
# format(round(main_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx,4)
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx <- sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_w_cov[[1]]
colnames(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx) <- c("conf.low", "estimate", "conf.high", "sd")
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term <- rownames(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx)
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$ci_95 <-
paste("95% CI = (", format(round(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low, 3), nsmall = 3), ", ",
format(round(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
2 Year Linear Intervention") +
scale_color_grey() +
geom_text(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.3, 1.1)
table_of_RR_lin_eff_logistic_2_yr<- sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx[51:66,]
table_of_RR_lin_eff_logistic_2_yr$estimate <- round(exp(table_of_RR_lin_eff_logistic_2_yr$estimate), 3)
table_of_RR_lin_eff_logistic_2_yr$conf.low <- exp(table_of_RR_lin_eff_logistic_2_yr$conf.low)
table_of_RR_lin_eff_logistic_2_yr$conf.high <- exp(table_of_RR_lin_eff_logistic_2_yr$conf.high)
table_of_RR_lin_eff_logistic_2_yr$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_logistic_2_yr$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_logistic_2_yr$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_logistic_2_yr, "./Data/table_of_RR_lin_eff_logistic_2_yr_5_9_22.csv")7.6.2 Plot Effects
plot_data <- data.frame(time_after_tx = 0:38,
coef = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38),
conf.low = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38),
conf.high = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:38))
ggplot(plot_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect")) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
title = "Estimated Effect of DIH Prosecutions Reported in the Media on
Drug OD Deaths by Number of Periods After Exposure,
Assuming Two Year Effect") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted")
7.6.3 Attributable Deaths
date_data_2yr <- sensitivity_anlys_event_study_data_lin_post_tx_2yr[, c("Time_Period_ID", "Time_Period_Start")]
date_data_2yr <- date_data_2yr[!duplicated(date_data_2yr),]
var_cov_mat_beta_logistic_tx_two_yr <- as.matrix(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_w_cov[[2]][
c("int_2_yr_effect", "lag_num_pd_w_tx"), c("int_2_yr_effect", "lag_num_pd_w_tx")])
attr_deaths_est_logistic_lin_time_lin_post_tx_2yr <- attr_death_compute(sensitivity_anlys_event_study_data_lin_post_tx_2yr,
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx,
lin_model = TRUE,
tx_name = c("int_2_yr_effect", "lag_num_pd_w_tx"),
var_cov_mat_beta_logistic_tx_two_yr)
attr_deaths_est_logistic_lin_time_lin_post_tx_2yr <- merge(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr, date_data_2yr,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
7.7 Linear Policy Measures Post Tx Subset Logistic Model
sens_data_subset <- sensitivity_anlys_event_study_data_lin_post_tx_2yr %>%
filter(Time_Period_ID <= 30)
#run the gam model
sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr<-gam(cbind(round(imputed_deaths), round(num_alive))~ State +
s(Time_Period_ID, bs = 'cr', by = as.factor(Region)) +
Naloxone_Pharmacy_Yes_Redefined +
lag_num_pd_w_naloxone_yes +
Naloxone_Pharmacy_No_Redefined +
lag_num_pd_w_naloxone_no +
Medical_Marijuana_Redefined +
lag_num_pd_w_med_marijuana +
Recreational_Marijuana_Redefined +
lag_num_pd_w_rec_marijuana +
GSL_Redefined +
lag_num_pd_w_gsl +
PDMP_Redefined +
lag_num_pd_w_pdmp +
Medicaid_Expansion_Redefined +
lag_num_pd_w_medicaid +
int_2_yr_effect +
lag_num_pd_w_tx,
data = sens_data_subset,
family = "binomial")
summary(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)##
## Family: binomial
## Link function: logit
##
## Formula:
## cbind(round(imputed_deaths), round(num_alive)) ~ State + s(Time_Period_ID,
## bs = "cr", by = as.factor(Region)) + Naloxone_Pharmacy_Yes_Redefined +
## lag_num_pd_w_naloxone_yes + Naloxone_Pharmacy_No_Redefined +
## lag_num_pd_w_naloxone_no + Medical_Marijuana_Redefined +
## lag_num_pd_w_med_marijuana + Recreational_Marijuana_Redefined +
## lag_num_pd_w_rec_marijuana + GSL_Redefined + lag_num_pd_w_gsl +
## PDMP_Redefined + lag_num_pd_w_pdmp + Medicaid_Expansion_Redefined +
## lag_num_pd_w_medicaid + int_2_yr_effect + lag_num_pd_w_tx
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.9940920 0.0165638 -603.368 < 2e-16 ***
## StateAlaska 0.5704251 0.0389754 14.636 < 2e-16 ***
## StateArizona 0.3903527 0.0178959 21.812 < 2e-16 ***
## StateArkansas -0.3055744 0.0261935 -11.666 < 2e-16 ***
## StateCalifornia 0.0199033 0.0243552 0.817 0.41381
## StateColorado 0.3072100 0.0253506 12.118 < 2e-16 ***
## StateConnecticut 0.2647991 0.0227014 11.664 < 2e-16 ***
## StateDelaware 0.2648217 0.0325417 8.138 4.02e-16 ***
## StateFlorida 0.5227044 0.0179353 29.144 < 2e-16 ***
## StateGeorgia 0.0919452 0.0184768 4.976 6.48e-07 ***
## StateHawaii -0.2559009 0.0380658 -6.723 1.79e-11 ***
## StateIdaho -0.2913733 0.0321544 -9.062 < 2e-16 ***
## StateIllinois 0.1775955 0.0201036 8.834 < 2e-16 ***
## StateIndiana -0.1166725 0.0203197 -5.742 9.37e-09 ***
## StateIowa -0.6980084 0.0275671 -25.320 < 2e-16 ***
## StateKansas -0.2393622 0.0246235 -9.721 < 2e-16 ***
## StateKentucky 0.5731072 0.0193495 29.619 < 2e-16 ***
## StateLouisiana 0.3555001 0.0183982 19.323 < 2e-16 ***
## StateMaine 0.1515154 0.0349014 4.341 1.42e-05 ***
## StateMaryland -1.4791166 0.0319252 -46.331 < 2e-16 ***
## StateMassachusetts -0.0268117 0.0199714 -1.343 0.17943
## StateMichigan -0.0516862 0.0202606 -2.551 0.01074 *
## StateMinnesota -0.4853177 0.0251070 -19.330 < 2e-16 ***
## StateMississippi -0.0331251 0.0224995 -1.472 0.14095
## StateMissouri 0.2578009 0.0207321 12.435 < 2e-16 ***
## StateMontana -0.0932257 0.0381194 -2.446 0.01446 *
## StateNebraska -0.8087276 0.0368186 -21.965 < 2e-16 ***
## StateNevada 0.6116326 0.0262068 23.339 < 2e-16 ***
## StateNew Hampshire 0.2002867 0.0288652 6.939 3.96e-12 ***
## StateNew Jersey 0.0784250 0.0180615 4.342 1.41e-05 ***
## StateNew Mexico 0.9356101 0.0256184 36.521 < 2e-16 ***
## StateNew York -0.3150371 0.0188756 -16.690 < 2e-16 ***
## StateNorth Carolina 0.2099208 0.0167790 12.511 < 2e-16 ***
## StateNorth Dakota -1.2635431 0.0665977 -18.973 < 2e-16 ***
## StateOhio 0.5089304 0.0177118 28.734 < 2e-16 ***
## StateOklahoma 0.4048662 0.0203332 19.912 < 2e-16 ***
## StateOregon 0.1447300 0.0289562 4.998 5.79e-07 ***
## StatePennsylvania 0.5029050 0.0194993 25.791 < 2e-16 ***
## StateRhode Island 0.1444098 0.0319644 4.518 6.25e-06 ***
## StateSouth Carolina 0.1823589 0.0189975 9.599 < 2e-16 ***
## StateSouth Dakota -0.9878693 0.0564320 -17.505 < 2e-16 ***
## StateTennessee 0.3444484 0.0172974 19.913 < 2e-16 ***
## StateTexas -0.1383717 0.0176081 -7.858 3.89e-15 ***
## StateUtah -0.1365666 0.0257712 -5.299 1.16e-07 ***
## StateVermont -0.0597918 0.0434224 -1.377 0.16852
## StateVirginia -0.1419516 0.0192643 -7.369 1.72e-13 ***
## StateWashington 0.4295969 0.0253198 16.967 < 2e-16 ***
## StateWest Virginia 0.7023825 0.0218277 32.178 < 2e-16 ***
## StateWisconsin 0.0803056 0.0204144 3.934 8.36e-05 ***
## StateWyoming 0.0234258 0.0416361 0.563 0.57368
## Naloxone_Pharmacy_Yes_Redefined -0.1017463 0.0137698 -7.389 1.48e-13 ***
## lag_num_pd_w_naloxone_yes -0.0266718 0.0036787 -7.250 4.16e-13 ***
## Naloxone_Pharmacy_No_Redefined 0.0879798 0.0106238 8.281 < 2e-16 ***
## lag_num_pd_w_naloxone_no -0.0132960 0.0012389 -10.732 < 2e-16 ***
## Medical_Marijuana_Redefined 0.0251814 0.0101224 2.488 0.01286 *
## lag_num_pd_w_med_marijuana -0.0073101 0.0010646 -6.866 6.59e-12 ***
## Recreational_Marijuana_Redefined -0.0759374 0.0382852 -1.983 0.04732 *
## lag_num_pd_w_rec_marijuana -0.0263943 0.0185488 -1.423 0.15475
## GSL_Redefined -0.0305314 0.0103521 -2.949 0.00319 **
## lag_num_pd_w_gsl 0.0009969 0.0025707 0.388 0.69816
## PDMP_Redefined -0.0083421 0.0078626 -1.061 0.28870
## lag_num_pd_w_pdmp 0.0092754 0.0008061 11.507 < 2e-16 ***
## Medicaid_Expansion_Redefined 0.0262864 0.0104455 2.517 0.01185 *
## lag_num_pd_w_medicaid 0.0208138 0.0029797 6.985 2.85e-12 ***
## int_2_yr_effect 0.0396273 0.0055026 7.202 5.95e-13 ***
## lag_num_pd_w_tx -0.0148389 0.0005735 -25.874 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(Time_Period_ID):as.factor(Region)Midwest 8.485 8.919 3307 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)Northeast 8.693 8.971 1828 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)South 8.687 8.970 3288 <2e-16 ***
## s(Time_Period_ID):as.factor(Region)West 8.916 8.998 1254 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.88 Deviance explained = 87.1%
## UBRE = 5.6567 Scale est. = 1 n = 14807.7.1 Sandwich Estimator
#compute the full dataset including basis functions
full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_subset_2yr <-
model.matrix(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)
#estimate the 95% CI and SD
coefficient_values_logistic_fixed_lin_time_lin_post_tx_subset_2yr <- coef(sensitivity_anlys_lin_post_tx_model_linear_time_subset_2yr)
#type = "response" to get the estimated probabilities
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset_w_cov <-
compute_sd_and_CI(full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_subset_2yr,
log(sens_data_subset$prop_dead),
coefficient_values_logistic_fixed_lin_time_lin_post_tx_subset_2yr,
k = ncol(full_df_w_basis_functions_logistic_fixed_lin_time_lin_post_tx_subset_2yr),
print_full_cov = TRUE)
# format(round(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset,4)
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset <-
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset_w_cov[[1]]
colnames(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset) <- c("conf.low", "estimate", "conf.high", "sd")
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term <-
rownames(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset)
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$ci_95 <-
paste("95% CI = (", format(round(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.low, 3), nsmall = 3), ", ",
format(round(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.high, 3), nsmall = 3), ")", sep = "")
dwplot(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset[51:66,], colour = "black") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
geom_vline(aes(xintercept = 0), linetype = "dashed") +
labs(y = "Term", x = "Coefficients and 95% Confidence Intervals",
title = "Coefficient of Analysis With Smoothed Time Effects,
2 Year Linear Intervention, Subset Data") +
scale_color_grey() +
geom_text(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset[51:66,],
mapping = aes(label = format(round(estimate, 3), nsmall = 3), x = 0.55, y = 16:1), size = 3) +
geom_text(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset[51:66,],
mapping = aes(label = ci_95, x = 0.9, y = 16:1), size = 3) +
xlim(-.5, 1.1)
table_of_RR_lin_eff_logistic_2_yr_subset<- sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset[51:66,]
table_of_RR_lin_eff_logistic_2_yr_subset$estimate <- round(exp(table_of_RR_lin_eff_logistic_2_yr_subset$estimate), 3)
table_of_RR_lin_eff_logistic_2_yr_subset$conf.low <- exp(table_of_RR_lin_eff_logistic_2_yr_subset$conf.low)
table_of_RR_lin_eff_logistic_2_yr_subset$conf.high <- exp(table_of_RR_lin_eff_logistic_2_yr_subset$conf.high)
table_of_RR_lin_eff_logistic_2_yr_subset$ci_95 <- paste("95% CI = (",
format(round(table_of_RR_lin_eff_logistic_2_yr_subset$conf.low, 3), nsmall = 3), ", ",
format(round(table_of_RR_lin_eff_logistic_2_yr_subset$conf.high, 3), nsmall = 3), ")", sep = "")
write.csv(table_of_RR_lin_eff_logistic_2_yr_subset, "./Data/table_of_RR_lin_eff_logistic_2_yr_subset_5_9_22.csv")7.7.2 Plot Effects
plot_data_subset_data <- data.frame(time_after_tx = 0:28,
coef = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
conf.low = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
conf.high = sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28))
ggplot(plot_data_subset_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect")) +
geom_line(aes(y = conf.low, linetype = "95% CI")) +
geom_line(aes(y = conf.high, linetype = "95% CI")) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
title = "Estimated Effect of DIH Prosecutions Reported in the Media on
Drug OD Deaths by Number of Periods After Exposure,
Assuming Two Year Effect, Without Last 5 Years") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted")
7.7.3 Attributable Deaths
date_data_subset_2yr <- sens_data_subset[, c("Time_Period_ID", "Time_Period_Start")]
date_data_subset_2yr <- date_data_subset_2yr[!duplicated(date_data_subset_2yr),]
var_cov_mat_beta_logistic_tx_two_yr_subset <- as.matrix(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset_w_cov[[2]][
c("int_2_yr_effect", "lag_num_pd_w_tx"), c("int_2_yr_effect", "lag_num_pd_w_tx")])
attr_deaths_est_logistic_lin_time_lin_post_tx_subset_2yr <- attr_death_compute(sens_data_subset,
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset,
lin_model = TRUE,
tx_name = c("int_2_yr_effect", "lag_num_pd_w_tx"),
var_cov_mat_beta_logistic_tx_two_yr_subset)
attr_deaths_est_logistic_lin_time_lin_post_tx_subset_2yr <- merge(attr_deaths_est_logistic_lin_time_lin_post_tx_subset_2yr, date_data_subset_2yr,
by.x = "Time_Period", by.y = "Time_Period_ID")
ggplot(attr_deaths_est_logistic_lin_time_lin_post_tx_subset_2yr, aes(x = Time_Period_Start)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
scale_linetype_manual(values = c("dashed", "solid"))
8 Plot All Effects
8.1 All Years
plot_effects_all_yr_data <- data.frame(time_after_tx = rep(0:39, 4),
coef = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
c(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$estimate[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$estimate[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$estimate[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$estimate[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
conf.low = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
c(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.low[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.low[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.low[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.low[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
conf.high = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
c(sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.high[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$conf.high[
sensitivity_anlys_post_tx_sd_and_ci_log_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.high[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "Intervention_Redefined"] +
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$conf.high[
sensitivity_anlys_post_tx_sd_and_ci_logistic_smoothed_time_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
estimator = c(rep("Log Model with All Time Periods", 40),
rep("Logistic GAM with All Time Periods", 40),
rep("Log Model with Subset Time Periods", 40),
rep("Logistic GAM with Subset Time Periods", 40)))
pdf("./Figures/all_yr_effects_all_models_5_9_22.pdf")
ggplot(plot_effects_all_yr_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect", color = estimator)) +
geom_line(aes(y = conf.low, linetype = "95% CI", color = estimator)) +
geom_line(aes(y = conf.high, linetype = "95% CI", color = estimator)) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted") +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
dev.off() ## quartz_off_screen
## 2attr_deaths_all_yr <- rbind(cbind(attr_deaths_est_log_smoothed_time_lin_post_summary,
"estimator" = "Log Model with All Time Periods"),
cbind(attr_deaths_est_logistic_smoothed_time_lin_post_summary,
"estimator" = "Logistic GAM with All Time Periods"),
cbind(attr_deaths_est_log_smoothed_time_lin_post_subset_summary,
"estimator" = "Log Model with Subset Time Periods"),
cbind(attr_deaths_est_logistic_smoothed_time_lin_post_subset_summary,
"estimator" = "Logistc GAM with Subset Time Periods"))
pdf("./Figures/lives_saved_all_yr_5_9_22.pdf")
ggplot(attr_deaths_all_yr, aes(x = year, color = estimator)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = total_attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = total_attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = total_attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
# title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
# Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "",
color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid"))+
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
dev.off()## quartz_off_screen
## 28.2 Two Years
plot_effects_two_yr_data <- data.frame(time_after_tx = rep(0:39, 4),
coef = c(
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
c(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
conf.low = c(
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
c(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
conf.high = c(
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
c(sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28)),
c(sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx_subset$term == "lag_num_pd_w_tx"]*c(0:28),
rep(NA, 39 - 28))),
estimator = c(rep("Log Model with All Time Periods", 40),
rep("Logistic GAM with All Time Periods", 40),
rep("Log Model with Subset Time Periods", 40),
rep("Logistic GAM with Subset Time Periods", 40)))
pdf("./Figures/two_yr_effects_all_models_5_9_22.pdf")
ggplot(plot_effects_two_yr_data, aes(x = time_after_tx)) +
geom_line(aes(y = coef, linetype = "Estimated Effect", color = estimator)) +
geom_line(aes(y = conf.low, linetype = "95% CI", color = estimator)) +
geom_line(aes(y = conf.high, linetype = "95% CI", color = estimator)) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Effect",
color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 0), color = "grey", linetype = "dotted") +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
dev.off() ## quartz_off_screen
## 2attr_deaths_all_2yr <- rbind(cbind(attr_deaths_est_log_lin_time_lin_post_tx_2yr, "estimator" = "Log Model with All Time Periods"),
cbind(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr, "estimator" = "Logistic GAM with All Time Periods"),
cbind(attr_deaths_est_log_lin_time_lin_post_tx_subset_2yr,
"estimator" = "Log Model with Subset Time Periods"),
cbind(attr_deaths_est_logistic_lin_time_lin_post_tx_subset_2yr,
"estimator" = "Logistc GAM with Subset Time Periods"))
pdf("./Figures/lives_saved_all_2_yr_5_9_22.pdf")
ggplot(attr_deaths_all_2yr, aes(x = Time_Period_Start, color = estimator)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
# title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
# Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "",
color = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid"))+
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE))
dev.off()## quartz_off_screen
## 28.3 Log and Logistic Model All Years
plot_effects_log_all_yr_data <- data.frame(time_after_tx = rep(0:39, 2),
coef = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
conf.low = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
conf.high = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39),
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_logistic_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_logistic_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
model = c(rep("Log GAM: Lasting Effect", 40),
rep("Log GAM: Two Year Effect", 40),
rep("Logistic GAM: Lasting Effect", 40),
rep("Logistic GAM: Two Year Effect", 40)))
pdf("./Figures/log_and_logistic_models_all_yr_effects_5_9_22_RR.pdf")
ggplot(plot_effects_log_all_yr_data, aes(x = time_after_tx)) +
geom_line(aes(y = exp(coef), linetype = "Estimated Effect", color = model)) +
geom_point(aes(y = exp(coef), linetype = "Estimated Effect", shape = model, color = model)) +
geom_line(aes(y = exp(conf.low), linetype = "95% CI", color = model)) +
geom_line(aes(y = exp(conf.high), linetype = "95% CI", color = model)) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Risk Ratio",
color = "", shape = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 1), color = "grey", linetype = "dotted") +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE),
shape = guide_legend(nrow=2,byrow=TRUE)) +
scale_shape_manual(values = c(19, 4, 17, 5))
dev.off() ## quartz_off_screen
## 2attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col <-
attr_deaths_est_log_lin_time_lin_post_tx_2yr[,c(1:(ncol(attr_deaths_est_log_lin_time_lin_post_tx_2yr) -1))]
attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col$Time_Period <-
year(attr_deaths_est_log_lin_time_lin_post_tx_2yr$Time_Period_Start)
attr_deaths_est_logistic_lin_time_lin_post_tx_2yr_wo_last_col <-
attr_deaths_est_logistic_lin_time_lin_post_tx_2yr[,c(1:(ncol(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr) -1))]
attr_deaths_est_logistic_lin_time_lin_post_tx_2yr_wo_last_col$Time_Period <-
year(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr$Time_Period_Start)
colnames(attr_deaths_est_log_smoothed_time_lin_post_summary) <-
colnames(attr_deaths_est_logistic_smoothed_time_lin_post_summary) <-
colnames(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col) <-
colnames(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr_wo_last_col) <-
c("Time_Period", "attr_deaths", "attr_deaths_lb", "attr_deaths_ub")
attr_deaths_all_yr_effect <- rbind(cbind(attr_deaths_est_log_smoothed_time_lin_post_summary, "model" = "Log Model: Lasting Effect"),
cbind(attr_deaths_est_logistic_smoothed_time_lin_post_summary, "model" = "Logistic GAM: Lasting Effect"),
cbind(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col, "model" = "Log Model: Two Year Effect"),
cbind(attr_deaths_est_logistic_lin_time_lin_post_tx_2yr_wo_last_col,
"model" = "Logistic GAM: Two Year Effect"))
pdf("./Figures/lives_saved_main_models_5_9_22.pdf")
ggplot(attr_deaths_all_yr_effect, aes(x = Time_Period, shape = model, color = model)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
geom_point(aes(y = attr_deaths)) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
# title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
# Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "",
color = "",
shape = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid"))+
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE),
shape=guide_legend(nrow=2,byrow=TRUE))+
scale_shape_manual(values = c(19, 4, 17, 5))
dev.off()## quartz_off_screen
## 28.4 Only Log Model All Years
plot_effects_only_log_all_yr_data <- data.frame(time_after_tx = rep(0:39, 2),
coef = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$estimate[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$estimate[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
conf.low = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.low[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.low[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
conf.high = c(
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "Intervention_Redefined"] +
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$conf.high[
sensitivity_anlys_lin_post_tx_sd_and_ci_log_smoothed_time$term == "lag_num_pd_w_tx"]*c(0:39),
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "int_2_yr_effect"] +
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$conf.high[
sens_analysis_sd_and_ci_log_fixed_lin_time_lin_post_tx$term == "lag_num_pd_w_tx"]*c(0:39)),
model = c(rep("Lasting Effect", 40),
rep("Two Year Effect", 40)))
pdf("./Figures/only_log_models_all_yr_effects_5_9_22_RR.pdf")
ggplot(plot_effects_only_log_all_yr_data, aes(x = time_after_tx)) +
geom_line(aes(y = exp(coef), linetype = "Estimated Effect", color = model)) +
geom_point(aes(y = exp(coef), linetype = "Estimated Effect", shape = model, color = model)) +
geom_line(aes(y = exp(conf.low), linetype = "95% CI", color = model)) +
geom_line(aes(y = exp(conf.high), linetype = "95% CI", color = model)) +
scale_linetype_manual(values = c("dashed", "solid")) +
labs(linetype = "",
x = "Number of Periods After Treatment",
y = "Estimated Risk Ratio",
color = "", shape = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
geom_hline(aes(yintercept = 1), color = "grey", linetype = "dotted") +
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE),
shape = guide_legend(nrow=2,byrow=TRUE)) +
scale_shape_manual(values = c(19, 4, 17, 5))
dev.off() ## quartz_off_screen
## 2attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col <-
attr_deaths_est_log_lin_time_lin_post_tx_2yr[,c(1:(ncol(attr_deaths_est_log_lin_time_lin_post_tx_2yr) -1))]
attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col$Time_Period <-
year(attr_deaths_est_log_lin_time_lin_post_tx_2yr$Time_Period_Start)
colnames(attr_deaths_est_log_smoothed_time_lin_post_summary) <-
colnames(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col) <-
c("Time_Period", "attr_deaths", "attr_deaths_lb", "attr_deaths_ub")
attr_deaths_all_yr_effect_only_log <- rbind(cbind(attr_deaths_est_log_smoothed_time_lin_post_summary,
"model" = "Lasting Effect"),
cbind(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col, "model" = "Two Year Effect"))
pdf("./Figures/lives_saved_only_log_models_5_9_22.pdf")
ggplot(attr_deaths_all_yr_effect_only_log, aes(x = Time_Period, shape = model, color = model)) +
# geom_point(aes(y = attr_deaths)) +
geom_line(aes(y = attr_deaths, linetype = "Estimate")) +
geom_point(aes(y = attr_deaths)) +
# geom_point(aes(y = attr_deaths_lb)) +
geom_line(aes(y = attr_deaths_lb, linetype = "95% CI")) +
# geom_point(aes(y = attr_deaths_ub)) +
geom_line(aes(y = attr_deaths_ub, linetype = "95% CI")) +
labs(x = "Date", y = "Lives Saved",
# title = "Estimated Number of Lives Saved Using Smoothed Time Effects,
# Log Probability of Drug Overdose Death, 2 Year Linear Policy Effects",
linetype = "",
color = "",
shape = "") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
legend.position = "bottom") +
scale_linetype_manual(values = c("dashed", "solid"))+
guides(color=guide_legend(nrow=2,byrow=TRUE),
linetype=guide_legend(nrow=2,byrow=TRUE),
shape=guide_legend(nrow=2,byrow=TRUE))+
scale_shape_manual(values = c(19, 4, 17, 5))
dev.off()## quartz_off_screen
## 2sum(attr_deaths_est_log_smoothed_time_lin_post_summary$attr_deaths)## [1] 197297.8sum(attr_deaths_est_log_smoothed_time_lin_post_summary$attr_deaths_lb)## [1] -73711.92sum(attr_deaths_est_log_smoothed_time_lin_post_summary$attr_deaths_ub)## [1] 468307.4sum(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col$attr_deaths)## [1] 67363.52sum(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col$attr_deaths_lb)## [1] -55713.72sum(attr_deaths_est_log_lin_time_lin_post_tx_2yr_wo_last_col$attr_deaths_ub)## [1] 190440.8